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

| 我对VBA相当陌生-我的大部分编程工作都是在PHP中完成的-自VB5以来，我从未接触过任何类似于VB的东西。我被要求学习VBA并在工作中做得不错-但被卡住了。 我们的电子表格有3张纸（4张，包括我们要输出到的1张纸），我们正在尝试进行比较。我已经弄清了大部分工作，但仍停留在其中。在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进行匹配。 我敢肯定有一个简单的方法可以做到这一点-我只是找不到。 任何帮助，将不胜感激。谢谢。     
2020-02-14 4 条评论
分享

没有找到相关结果

    已邀请:

    森含械

            假设您要执行以下操作： 
        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
    这有帮助吗？     
    2020-02-14 0 0
    分享

    仇聘发栖

            为此，您不需要VBA，只需几个Excel查找功能，即Match和Index。为此，请将标头和数据从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
        
    2020-02-14 0 0
    分享

    豪抱怒掳

            
    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
        
    2020-02-14 0 0
    分享
    为什么被折叠? 0 个回复被折叠

    要回复问题请先登录或注册

    或代码 OrCode.com 备案号：粤ICP备15020848号-1
    Escape time: 0.035974025726318