Question

我想仅通过使用标题名称来复制已过滤的列，而不知道其范围。

Sub RecoverData()
Application.ScreenUpdating = False
Dim x As Workbook

'## Open both workbooks first:
Set x = Workbooks.Open(Application.ActiveWorkbook.Path & "\data.xlsx")

With x.Sheets("Feuil1").Rows(1)
    Range("A1").AutoFilter Field:=2, Criteria1:=Array("a*", "b"), Operator:=xlFilterValues
    Set t = .Find("Vendor name", lookat:=xlWhole)
    If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
        Destination:=ThisWorkbook.Sheets("Feuil2").Range("B1")
    Else: MsgBox "Column Name Not Found"
    End If
End With
x.Close
ThisWorkbook.Sheets("Feuil2").Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
Application.ScreenUpdating = True
End Sub

实际上我的代码看起来像这样，但是由于隐藏的单元格，所以我用来复制列的方法不起作用。我尽我所能，告诉我是否仍然需要更多细节。谢谢。

Answer 1

您可以尝试以下方法：

Sub RecoverData()
    Application.ScreenUpdating = False
    Dim x As Workbook
    Dim t As Range

    '## Open both workbooks first:
    Set x = Workbooks.Open(Application.ActiveWorkbook.Path & "\data.xlsx")

    With x.Sheets("Feuil1") ' reference source sheet
        Set t = .Rows(1).Find("Vendor name", lookat:=xlWhole) ' try searching wanted header in referenced sheet first row
        If Not t Is Nothing Then ' if found
            .Rows(1).AutoFilter Field:=t.column, Criteria1:=Array("a*", "b"), Operator:=xlFilterValues ' filter data
            Intersect(.UsedRange, t.EntireColumn).SpecialCells(xlCellTypeVisible).Copy _
            Destination:=ThisWorkbook.Sheets("Feuil2").Range("A1") '<<== paste filtered column to destination sheet A1 cell (instead of B1), to match your subsequent removeduplicates call
            ThisWorkbook.Sheets("Feuil2").Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
            .AutoFilterMode = False
        Else
            MsgBox "Column Name Not Found"
        End If
    End With
    x.Close

    Application.ScreenUpdating = True
End Sub

Answer 2

感谢DisplayName，我仅更改了2或3件事，现在它可以工作了。如果有人需要一天，这是我的代码

Sub RecoverData()
Application.ScreenUpdating = False
Dim x As Workbook
Dim t As Range

'## Open both workbooks first:
Set x = Workbooks.Open(Application.ActiveWorkbook.Path & "\data.xlsx")

With x.Sheets("Feuil1") ' reference source sheet
    Set t = .Rows(1).Find("Vendor name", lookat:=xlWhole) ' try searching wanted header in referenced sheet first row
    If Not t Is Nothing Then ' if found
        Range(t.Address).AutoFilter Field:=2, Criteria1:=Array("a*", "b*"), Operator:=xlFilterValues
        Intersect(.UsedRange, t.EntireColumn).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=ThisWorkbook.Sheets("Feuil2").Range("A1") '<<== paste filtered column to destination sheet A1 cell (instead of B1), to match your subsequent removeduplicates call
        ThisWorkbook.Sheets("Feuil2").Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
        .AutoFilterMode = False
    Else
        MsgBox "Column Name Not Found"
    End If
End With
x.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

Excel VBA如何在不知道范围的情况下复制过滤的列

2 个答案: