在Excel中的后續列中重復進行VBA查找

Question

正如您可能可以從代碼中看出來的那樣，我對VBA還是很陌生，所以如果這真是一個愚蠢的問題，我們深表歉意。

我需要一個代碼塊，該代碼塊在一個工作表（RawData）中查找在全局變量Verb1中指定的文本字符串，並將其粘貼到其他工作表（Verbatim）的第一空列中。

我的困難是，存儲在Verb1中的字符串在RawData中可能出現1、2或3次，因此，即使在找到字符串的第一個匹配項后，我仍需要使用Find函數來檢查多列。

但是，我的代碼實際上正在執行的操作是復制保存字符串的第一個匹配項的列，並將其粘貼與搜索范圍內的列數相等的次數...在本例中為688次。

我檢查了代碼是否可以在不使用For ... Next語句的情況下運行（即，它找到字符串的第一個匹配項，並將其粘貼到Verbatim工作表的第一個空白列中），但是我看不到錯誤在此聲明中。

Public Verb1 As String

Sub Paste2()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim aCell As Range
Dim NextCol As Long

Set ws1 = ThisWorkbook.Sheets("RawData")
Set ws2 = ThisWorkbook.Sheets("Verbatim")
Set Rng = ThisWorkbook.Sheets("RawData").Range("A1:ZZ1")
NextCol = 0

Worksheets("RawData").Activate
With ws1
'Copy and Paste Verbatim
For Each Cell in Rng
    NextCol = NextCol + 1
    Set aCell = Worksheets("RawData").Range("A1:ZZ1").Find(What:=Verb1, 
    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
    aCell.EntireColumn.Copy ws2.Cells(1, NextCol)
Next Cell
End With
End Sub

誰能指出我正確的方向？

在此先感謝您的幫助。

Answer 1

您應該為After to Set aCell添加選項：

首先，在With語句之前，添加Set aCell = rng.Cells(1, 1) 。 然后將“ Set aCell切換為：

Set aCell = Worksheets("RawData").Range("A1:ZZ1").Find(What:=Verb1, _
    LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False, after:=aCell)

另外，可能還有一種更優雅的方法，但是由於您要遍歷范圍中的單元格，而不管是否找到了字符串的所有實例，因此可以添加一個快速的COUNTIF()來查看應該執行多少次復制信息：

Sub Paste2()

Dim ws1     As Worksheet, ws2     As Worksheet
Dim aCell   As Range, rng As Range, cel As Range
Dim NextCol As Long, numOccur As Long

Set ws1 = ThisWorkbook.Sheets("RawData")
Set ws2 = ThisWorkbook.Sheets("Verbatim")
Set rng = ThisWorkbook.Sheets("RawData").Range("A1:ZZ1")
NextCol = 0

numOccur = Application.WorksheetFunction.CountIf(rng, Verb1)

Set aCell = rng.Cells(1, 1)
With ws1
    'Copy and Paste Verbatim
    For Each cel In rng
        NextCol = NextCol + 1
        Set aCell = .Range("A1:ZZ1").Find(What:=Verb1, LookIn:=xlValues, LookAt:=xlPart, _
            MatchCase:=False, SearchFormat:=False, SearchDirection:=xlNext, After:=aCell)
        Debug.Print Verb1 & " found in cell " & aCell.Address
        aCell.EntireColumn.Copy ws2.Cells(1, NextCol)
        If NextCol = numOccur Then Exit For
    Next cel
End With
End Sub

Answer 2

這是使用.FindNext並清理一些代碼的另一種方法。

Option Explicit

Public Verb1 As String

Sub Paste2()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim aCell As Range
Dim Rng As Range
Dim NextCol As Long
Dim sFirstAddress As String

Set ws1 = ThisWorkbook.Sheets("RawData")
Set ws2 = ThisWorkbook.Sheets("Verbatim")
Set Rng = ThisWorkbook.Sheets("RawData").Range("A1:ZZ1")
NextCol = 0

'No need to "Activate"
'Worksheets("RawData").Activate

With Rng
'Copy and Paste Verbatim
    Set aCell = .Find(what:=Verb1, after:=Rng.End(xlToRight), LookIn:=xlValues, _
            lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlNext, _
            MatchCase:=False)
    If Not aCell Is Nothing Then
        sFirstAddress = aCell.Address
        NextCol = NextCol + 1
        aCell.EntireColumn.Copy ws2.Cells(1, NextCol)

        Do
            Set aCell = .FindNext(aCell)
            If Not aCell.Address = sFirstAddress Then
                NextCol = NextCol + 1
                aCell.EntireColumn.Copy ws2.Cells(1, NextCol)
            End If
        Loop Until sFirstAddress = aCell.Address
    End If
End With

End Sub