VBA：当单元格是特定值时获取行数据
我对VBA相当陌生 – 大部分编程都是在PHP中完成的 – 自从VB5以来，我一直没有触及任何类似VB的东西。 我被要求学习VBA的工作，并做得相当好 – 但卡住了。
我们的电子表格有3张（4张，包括我们正在输出的），我们正在尝试对它们进行比较。 我已经弄清了大部分的工作，但是我陷入了一个困境。 在Sheet2中，有一个列（QuickID）引用Sheet3中特定行中的值。 以下是一些示例的CSV：
Sheet2 Adam,3,1234 Bonnie,6,1237 Chris,19,1236 Donna,3,1235 Sheet3 1234,208,16,B 1235,7,39,B 1236,19,6,A 1237,35,12,C So, Column 3 in Sheet2 and Column 1 in Sheet 3 are the QuickID values I mentioned. 我试图做的是build立一个输出表，Sheet4，在那里我可以将Sheet2和Sheet3的值拉到一起，通过QuickID进行匹配。
我相信有一个简单的方法来做到这一点 – 我只是无法find它。
任何帮助，将不胜感激。 谢谢。
假设您想要执行以下操作：
Sheet2 Sheet3 Sheet4 ABCABCDABCDEF 1 Adam 3 1234 1234 208 16 B Adam 3 1234 208 16 B 2 Bonnie 6 1237 1235 7 39 B -----> Bonnie 6 1237 7 39 B 3 Chris 16 1236 1236 19 6 A Chris 16 1236 19 6 A 4 Donna 3 1235 1237 35 12 C Donna 3 1235 35 12 C
这段代码将有助于实现：
Sub CreateMatchedOutput() Dim quickIDSht2 As Range, quickIDSht3 As Range, id As Range Dim rng1 As Range, rng2 As Range Dim matchIndex As Long, cnt As Long Set quickIDSht2 = Worksheets("Sheet2").Range("C1:C4") //quickID column in Sheet2 Set quickIDSht3 = Worksheets("Sheet3").Range("A1:A4") //quickID column in Sheet3 cnt = 1 For Each id In quickIDSht2 Set rng1 = Worksheets("Sheet2").Range("A" & id.Row & ":C" & id.Row) //Get all data in row from Sheet2 matchIndex = WorksheetFunction.Match(id, quickIDSht3, 0) //match quickID in sheet2 to data in Sheet3 Set rng2 = Worksheets("Sheet3").Range("B" & matchIndex & ":D" & matchIndex) //Get all data in Sheet3 based on rowindex given by match above rng1.Copy Destination:=Worksheets("Sheet4").Range("A" & cnt) rng2.Copy Destination:=Worksheets("Sheet4").Range("D" & cnt) cnt = cnt + 1 Next id End Sub
这有帮助吗？
你不需要VBA，只需要几个Excel查找函数Match和Index。 为此，请将Sheet2中的标题和数据复制到Sheet4中。 假设您在第1行中有一个标题，并且您的数据在第2行中开始，那么您将在Sheet4中的E2中input以下内容：
=INDEX(Sheet2!A$2:A$5,MATCH($A2,Sheet2!$C$2:$C$5,0))
然后拖到F列并根据需要向下。
编辑：这在代码中做了同样的事情，有一个选项作为值复制公式。
Sub MergeData() Dim wbWithData As Excel.Workbook Dim ws2 As Excel.Worksheet Dim ws3 As Excel.Worksheet Dim ws4 As Excel.Worksheet Dim lngLastRow As Long Dim rngToFill As Excel.Range Dim cell As Excel.Range Set wbWithData = ThisWorkbook 'Change this as needed With wbWithData Set ws2 = .Worksheets("Sheet2") Set ws3 = .Worksheets("Sheet3") On Error Resume Next Application.DisplayAlerts = False 'delete if already exists .Worksheets("Sheet4").Delete On Error GoTo 0 Application.DisplayAlerts = True ws3.Copy after:=ws3 Set ws4 = ActiveSheet ws4.Name = "Sheet4" End With With ws4 lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row Set rngToFill = .Range("E2:F" & lngLastRow) rngToFill.Formula = "=INDEX(Sheet2!A$2:A$5,MATCH($A2,Sheet2!$C$2:$C$5,0))" 'do the following to paste results as values rngToFill = rngToFill.Value2 End With End Sub
Sub test() 'Application.ScreenUpdating = False Sheets("Sheet2").Select Rows("5:10000").Select 'keep only source data Selection.Delete Shift:=xlUp Dim vTotal_Row, vCurrent_row, vCurrent_column_p, vCurrent_column_d As Integer vCurrent_row_S = 1 'First row of source data vCurrent_row_d = 1 'First row of destination data vCurrent_column_S = 3 'First column of source data vCurrent_column_d = 1 'First column of destination data Do While vCurrent_row_S <= 6 'last row number of source data i = 1 vCurrent_column_p = 1 vCurrent_column_d = 1 Application.StatusBar = "Total row: 396" & " Processing row:" & vCurrent_row_P Do While i <= 4 If Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S) = Sheets("Sheet3").Cells(i, vCurrent_column_S - 2) Then Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S - 2) Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 1).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S - 1) Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 2).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S) Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 3).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S + 1) Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 4).Value = Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S - 2) Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 5).Value = Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S - 1) Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 6).Value = Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S) End If i = i + 1 Loop vCurrent_row_d = vCurrent_row_d + 1 'Increase current row of source data vCurrent_row_S = vCurrent_row_S + 1 Loop MsgBox "complete" End Sub