开发者

VBA: Getting row data when a cell is a specific value

开发者 https://www.devze.com 2023-03-14 07:25 出处:网络
I\'m fairly new to VBA - most of my programming is done in PHP - and I haven\'t touched anything VB-like since VB5. I\'ve been asked to learn VBA for work and am doing fairly well - but have gotten st

I'm fairly new to VBA - most of my programming is done in PHP - and I haven't touched anything VB-like since VB5. I've been asked to learn VBA for work and am doing fairly well - but have gotten stuck.

Our spreadsheet has 3 sheets (4, including the one we're outputting to) and we're trying to do comparisons between them. I've got most of the work figured out, but am stuck on one. In Sheet2, there's a column (QuickID) that references values in specific rows in Sheet3. Here's a CSV of some sample:

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.

What I'm attempting to do is build an output sheet, Sheet4, where I can pull the values of both Sheet2 and Sheet3 together, matching them up by QuickID.

I'm sure there's an easy way to do this - I just can't find it.

Any help would be apprec开发者_StackOverflow中文版iated. Thanks.


Suppose you want to do the following:

    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

This code will help achieve that:

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

Does this help?


You don't need VBA for this, just a couple of Excel lookup functions, Match and Index. To do this, copy your headers and data from Sheet2 into Sheet4. Assuming you have a header in Row 1 and your data starts in Row 2, you'd enter the following in E2 on Sheet4:

=INDEX(Sheet2!A$2:A$5,MATCH($A2,Sheet2!$C$2:$C$5,0))

Then drag over to column F and down as necessary.

Edit: This does the same thing in code, with an option to copy over the formulas as values.

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
0

精彩评论

暂无评论...
验证码 换一张
取 消