在Excel中的后续列上重复VBA查找

你可能会从代码中看出来，我对VBA相当陌生，所以如果事实certificate这是一个愚蠢的问题，那么我们是很抱歉的。

我需要一个代码块来查看一个工作表（RawData）中全局variablesVerb1中指定的文本string，并将其粘贴到不同工作表（Verbatim）的第一个空列中。

我的困难是存储在Verb1中的string可能会在RawData中出现1,2或3次，所以我需要使用Find函数来检查多个列，即使在find第一个string之后也是如此。

然而，我的代码实际上在做的是复制包含首次出现的string的列，并粘贴它的次数等于我的search范围中的列数…在这种情况下，688次。

我已经检查了代码的工作，没有For … Next语句（即它findstring的第一次出现，并将其粘贴到逐字logging工作表的第一个空白列），但我看不到错误在这个声明中。

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

您应该添加“ Set aCell After ”选项：

首先，在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) 

此外，可能会有更优雅的方式，但是由于您正在遍历范围中的单元格， 无论您是否findstring的所有实例，都可以添加一个快速COUNTIF()来查看您应该多less次复制信息：

 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