Question

我对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.

我正在尝试做的是构建一个输出表Sheet4，我可以将Sheet2和Sheet3的值拉到一起，通过QuickID匹配它们。

我确信有一种简单的方法可以做到这一点 - 我找不到它。

任何帮助将不胜感激。感谢。

Answer 1

假设您要执行以下操作：

    Sheet2              Sheet3                      Sheet4
    A      B  C         A      B    C   D           A      B  C     D    E   F
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

这有帮助吗？

Answer 2

您不需要VBA，只需要几个Excel查找功能，匹配和索引。为此，请将Sheet2中的标题和数据复制到Sheet4中。假设您在第1行中有一个标题，而您的数据在第2行开始，则在Sheet4的E2中输入以下内容：

=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

Answer 3

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

VBA：当单元格是特定值时获取行数据

3 个答案: