Question

我有一个大文件作为脏数据进入，需要清理。一些数据是混合的，因此需要一个高级过滤器才能显示“Dog”然后仅复制可见单元格（列的范围），将它们粘贴到指定的列（在标题下面的第一个可见空白单元格上）清除过滤器并重复在下一栏。需要搜索“Dog”的这些列每7列出现一次。即，A1，H1，O1等。我有以下脚本，我一直在努力尝试获得我正在寻找的结果。

2个问题： 1）当它对列410执行过滤时，它应该只复制可见单元格，但在粘贴之后它实际上包括当整个表未经过滤时的隐藏单元格。 2）如果此脚本正在执行预期的操作，由于此操作需要在50列上执行，因此多次使用select将会非常慢。

任何帮助表示赞赏！谢谢

Sub CopyPaste()

    ActiveSheet.Range("$A$1:$API$65536").AutoFilter Field:=403, Criteria1:= _
    "=*Dog*", Operator:=xlAnd
    Range("OM2:ABP65536").SpecialCells(xlCellTypeVisible).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut

    Dim Rng As Variant

    Range("ABQ1").Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Cells(1).Select
    ActiveSheet.Paste
    ActiveWorkbook.Worksheets("clean_report").AutoFilter.Sort.SortFields.Clear
    ActiveSheet.ShowAllData 
    ActiveSheet.Range("$A$1:$API$65536").AutoFilter Field:=410, Criteria1:= _
    "=*Dog*", Operator:=xlAnd
    Range("OT2:ABP65536").SpecialCells(xlCellTypeVisible).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("ABQ1").Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Cells(1).Select
    ActiveSheet.Paste
    ActiveWorkbook.Worksheets("clean_report").AutoFilter.Sort.SortFields.Clear
    ActiveSheet.ShowAllData

End Sub

Answer 1

我相信以下代码可以帮助您实现所需的结果，它将循环遍历从A开始的每7列直到您的最后一列数据，它将使用条件＆＃34; Dog＆＃34;来过滤给定列复制所有可见单元格并粘贴到另一张纸张中，在下面的纸张结果中显示：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("clean_report")
'declare and set your worksheet, amend as required
Dim wsResult As Worksheet: Set wsResult = Sheets("result")
'declare and set your worksheet, amend as required
Dim LastRow As Long, LastCol As Long, i As Long, ResultRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Lastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'get the last column with data on Row 1

For i = 1 To Lastcol Step 7 'go through columns A then H in 7 column intervals
    ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, Lastcol)).AutoFilter Field:=i, Criteria1:="*Dog*", Operator:=xlAnd
    'filter by "Dog"
    ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, Lastcol)).SpecialCells(xlCellTypeVisible).Copy
    'copy all visible cells from A2 to LastRow on LastCol
    ResultRow = wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row + 1
    'find next free row on result sheet
    wsResult.Range("A" & ResultRow).PasteSpecial xlPasteAll
    'paste in free row
    ws.ShowAllData
    'remove filter for next iteration of loop
Next i
End Sub

<强>更新

根据您的评论，请查看下面的更新版本，这将从A列循环到OI（以7列的间隔）并过滤单词＆＃34; Dog＆＃34;并将可见单元格粘贴到Column PB上的下一个可用空行：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("clean_report")
'declare and set your worksheet, amend as required
Dim wsResult As Worksheet: Set wsResult = Sheets("result")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A

For i = 1 To 399 Step 7 'go through columns A to OI in 7 column intervals
    ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, 402)).AutoFilter Field:=i, Criteria1:="*Dog*", Operator:=xlAnd
    'filter by "Dog"
    ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, 402)).SpecialCells(xlCellTypeVisible).Copy
    'copy all visible cells from A2 to LastRow on LastCol
    ResultRow = ws.Cells(ws.Rows.Count, "PB").End(xlUp).Row + 1
    'find next free row on result sheet
    ws.Range("PB" & ResultRow).PasteSpecial xlPasteAll
    'paste in free row
    ws.ShowAllData
    'remove filter for next iteration of loop
Next i
End Sub

在多列

1 个答案: