從過濾列復制并粘貼唯一值

我正在嘗試從過濾范圍中獲取唯一值并嘗試將其粘貼到特定作業表中。但我正面臨運行時錯誤 1004（資料庫或表范圍無效）。

Set DataSet = MainSht.Range(Cells(1, 1), Cells(Lrows, Lcols))

With DataSet
    .AutoFilter field:=3, Criteria1:=Array("Corporate Treasury - US", "F&A"), Operator:=xlFilterValues
    Set DataRng = .Offset(1, 10).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
    .AutoFilter
    With DataRng
    .AdvancedFilter Action:=xlFilterCopy, copytorange:=Wb.Sheets("Corporate Treasury - US").Range("A2"), Unique:=True 'Getting Error Here
    End With
End With

提前感謝您的幫助！！

uj5u.com熱心網友回復：

復制過濾的唯一資料

基本上

• “洗掉”以前的過濾器。
• 在應用之前創建準確的范圍參考AutoFilter。
• 過濾器應用于表范圍（包括標題）。
• 使用錯誤處理SpecialCells（認為沒有找到單元格）。
• 適用SpecialCells于資料范圍（無頭）。
• SpecialCells在創建對范圍的參考后“洗掉”過濾器通常是安全的。
• 復制/粘貼然后才應用RemoveDuplicates（xlNo當資料范圍時）。
• 或者，將Sort（xlNo當Data Range）應用于不一定準確的目標范圍（ducdrg即沒有空單元格（由于RemoveDuplicates））。
• （xlYes當Table Range .）

一項研究

• 調整常量部分中的值（作業表已關閉）。

Option Explicit

Sub CopyFilteredUniqueData()

    ' Source
    
    Const sName As String = "Sheet1"
    ' Copy
    Const sCol As Variant = "K" ' or 11
    ' Filter
    Const sfField As Long = 3
    Dim sfCriteria1 As Variant
    sfCriteria1 = Array("Corporate Treasury - US", "F&A")
    Dim sfOperator As XlAutoFilterOperator: sfOperator = xlFilterValues
    
    ' Destination
    
    Const dName As String = "Sheet2"
    ' Paste
    Const dFirst As String = "A2"

    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
        
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Debug.Print vbLf & "Source (""" & sws.Name & """)"
    
    ' Remove possble previous filters.
    If sws.AutoFilterMode Then
        sws.AutoFilterMode = False
    End If
    
    ' Source Table Range
    Dim strg As Range: Set strg = sws.Range("A1").CurrentRegion
    Debug.Print strg.Address(0, 0)
    
    ' Source Column Data Range (No Headers)
    Dim scdrg As Range
    With strg.Columns(sCol)
        Set scdrg = .Resize(.Rows.Count - 1).Offset(1)
    End With
    Debug.Print scdrg.Address(0, 0) & " (No Headers)"
 
    ' Filter.
    strg.AutoFilter sfField, sfCriteria1, sfOperator
    
    ' Source Filtered Column Data Range (No Headers)
    On Error Resume Next
    Dim sfcdrg As Range: Set sfcdrg = scdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    sws.AutoFilterMode = False ' no need for the filter anymore
    If sfcdrg Is Nothing Then Exit Sub ' no matching cells
    Debug.Print sfcdrg.Address(0, 0) & " (No Headers)"
    
    ' Destination
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Debug.Print vbLf & "Destination (""" & dws.Name & """)"
    
    ' Destination First Cell
    Dim dfCell As Range: Set dfCell = dws.Range(dFirst)
    
    ' Destination Column Data Range (No Headers)
    Dim dcdrg As Range: Set dcdrg = dfCell.Resize(sfcdrg.Cells.Count)
    Debug.Print dcdrg.Address(0, 0) & " (No Headers)"
     
    ' Copy.
    sfcdrg.Copy dcdrg
    
    ' Remove duplicates.
    dcdrg.RemoveDuplicates 1, xlNo
    Debug.Print dcdrg.Address(0, 0) & " (No Headers, Empty Cells Included)"
    
    ' Destination Last Cell
    Dim dlCell As Range
    Set dlCell = dcdrg.Find("*", , xlFormulas, , , xlPrevious)
    
    ' Destination Unique Column Data Range (No Headers)
    Dim ducdrg As Range
    With dcdrg
        Set ducdrg = .Resize(dlCell.Row - .Row   1)
    End With
    Debug.Print ducdrg.Address(0, 0) & " (No Headers, Empty Cells Excluded)"
    
    ' Sort ascending.
    ducdrg.Sort ducdrg, , Header:=xlNo
    
End Sub

uj5u.com熱心網友回復：

我認為該錯誤是因為它無法通過列中的一系列非連續單元格。

我通過簡單地使用.copy命令來解決這個問題，但這會將您的唯一串列與基礎格式粘貼在一起。請參閱下面的我的解決方案 -

> Set DataSet = MainSht.Range(Cells(1, 1), Cells(Lrows, Lcols))
> 
> With DataSet
>     .AutoFilter field:=3, Criteria1:=Array("Corporate Treasury - US", "F&A"), Operator:=xlFilterValues
>     Set DataRng = .Offset(1, 10).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
>     DataRng.Copy Destination:=Wb.Sheets("Corporate Treasury - US").Range("A2:A" & (DataRng.Rows.Count   2))
> 
> End With

如果您不想從原始作業表中引入單元格屬性/格式，您可以將.copy命令與 a結合使用，.pastespecial以僅粘貼值、公式或您需要的任何詳細資訊。

標籤：擅长 vba

上一篇：VBA|匯出為多頁PDF

下一篇：VBA查詢表回圈