重複VBA在Excel中隨後的列中查找

Question

正如你可能會從代碼中看出的那樣，我對VBA很新穎，所以如果這真是一個愚蠢的問題，請大家道歉。

我需要一個代碼塊來查看在全局變量Verb1中指定的文本字符串的一個工作表（RawData），並將其粘貼到不同工作表（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

下面是使用.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 

Answer 2

您應該添加選項After到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