search列中的string，并在成功匹配时复制下一列的值

我是VBA编程的新手。 我有一个情况，我需要从列的顶部searchstring，并匹配该列的后续行中的特定string。 这是我有什么：

基本上我需要一个vba prog，它将searchstring的多次出现，并获取第一次出现旁边的匹配string旁边的值。 如图所示。任何人都可以帮助我。 我logging了一个macros，但没有使用它，因为每个值都会改变。

> Sub Macro1() ' ' Macro1 Macro ' > > ' > Range("B32:B59").Select > Selection.Cut > ActiveWindow.SmallScroll Down:=-15 > Range("C2").Select > ActiveSheet.Paste > ActiveWindow.SmallScroll Down:=39 > Range("B62:B89").Select > Selection.Copy > Application.CutCopyMode = False > Selection.Cut > ActiveWindow.SmallScroll Down:=-60 > Range("D2").Select > ActiveSheet.Paste > ActiveWindow.SmallScroll Down:=78 > Range("B92:B119").Select > Selection.Cut > ActiveWindow.SmallScroll Down:=-96 > Range("E2").Select > ActiveSheet.Paste > ActiveWindow.SmallScroll Down:=114 > Range("B122:B149").Select > Selection.Cut > ActiveWindow.SmallScroll Down:=-144 > Range("F2").Select > ActiveSheet.Paste > ActiveWindow.SmallScroll Down:=147 > Range("B152:B179").Select > Selection.Cut > ActiveWindow.SmallScroll Down:=-168 > Range("G2").Select > ActiveSheet.Paste > ActiveWindow.SmallScroll Down:=15 > Range("A32:A179").Select > Selection.ClearContents > ActiveWindow.SmallScroll Down:=-42 End Sub 

这是一个简单的文件logging的MACRO。 这是示例结果文件：

Answer 1

这是一个VBA解决scheme，应该让你去。 我做了一些假设，所以你可能需要调整它来得到你的最终要求。

只能在您的数据副本上运行。 10,000行是很多修复工作！

它首先对数据进行sorting，遍历这些值并丢弃重复的行。 因此，输出是基于valCol的sorting顺序（数据中的列A）

我在Sheet3上使用了我的testing数据，原始数据位于(stDataRow, valCol) 。 在代码中更改这些以适应您的数据设置。

最后，请注意，在输出行中，列中值的顺序（从左到右）按原始数据中出现位置（从下到上）的顺序排列。

 Option Explicit Sub CollectData() Dim ws As Worksheet Dim stDataRow As Long, endDataRow As Long, valCol As Long Dim endDataCol As Long, colCnt As Long, c As Long Dim dataRng As Range, fndVal As Range Set ws = Sheets("Sheet3") stDataRow = 2 valCol = 1 With ws endDataRow = Cells(Rows.Count, valCol).End(xlUp).Row endDataCol = Cells(stDataRow, Columns.Count).End(xlToLeft).Column Set dataRng = .Range(.Cells(stDataRow, valCol), .Cells(endDataRow, endDataCol)) dataRng.Sort Key1:=Columns(valCol), Order1:=xlAscending For c = endDataRow To stDataRow + 1 Step -1 colCnt = valCol Set fndVal = .Cells(c, valCol) Do While fndVal.Value = fndVal.Offset(-1, 0).Value If fndVal.Value = fndVal.Offset(-1, 0).Value Then colCnt = colCnt + 1 fndVal.Offset(0, colCnt).Value = fndVal.Offset(-1, 1).Value fndVal.Offset(-1, 0).EntireRow.Delete End If Loop Next c End With End Sub