VBA: получение данных строки, когда ячейка имеет определенное значение

Question

Я довольно новичок в VBA - большая часть моего программирования выполняется на PHP - и я не касался ничего подобного VB с VB5.Меня попросили выучить 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, Match и Index. Для этого скопируйте свои заголовки и данные из Sheet2 в Sheet4. Предполагая, что у вас есть заголовок в строке 1, а ваши данные начинаются со строки 2, вы должны ввести следующее в E2 на листе 4:

=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