Excel:在列中搜索单词并将其复制到同一工作表上的另一列

时间:2013-08-07 10:22:20

标签: excel excel-vba vba

我有一个包含数据行的excel表。列J包含各种商品描述。我需要在此列的所有行中搜索单词LATEX,找到它时,只将该单词复制到同一行的同一工作表上的A列。我试图找到一个解决方案,并使用Autofilter提出了这个宏,但它无法正常工作。你能帮我吗?

Sub FilterAndCopy()

    Dim dataWs As Worksheet
    Dim copyWs As Worksheet
    Dim totRows As Long
    Dim lastRow As Long

    Set dataWs = Worksheets("Massiv")
    Set copyWs = Worksheets("Massiv")

    With dataWs
        .AutoFilterMode = False
        With .Range("J:J")
             .AutoFilter Field:=1, Criteria1:="LATEX"
        End With
    End With

    totRows = dataWs.Range("J:J").Rows.count
    lastRow = dataWs.Range("J" & totRows).End(xlUp).Row
    dataWs.Range("J:J" & lastRow).Copy
    copyWs.Range("A6").PasteSpecial Paste:=xlPasteValues
    dataWs.AutoFilterMode = False

1 个答案:

答案 0 :(得分:0)

通过以下更改,您的代码应该可以正常运行。我已经注意到代码中注释的变化。

With dataWs
    .AutoFilterMode = False
    With .Range("J:J")
         'Use wildcard to search for word LATEX within contents of column J cells 
         .AutoFilter Field:=1, Criteria1:="*LATEX*"
    End With
End With

totRows = dataWs.Range("J:J").Rows.Count
lastRow = dataWs.Range("J" & totRows).End(xlUp).Row
'After filtering, select the visible cells in column A...
Set rng = dataWs.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
'... and set their values to "LATEX"
rng.Value = "LATEX"
dataWs.AutoFilterMode = False