0

在工作表 2 中，A 列中有一组规则。

列 A 中的示例每行中有多个代码，行 B 到 H 具有基于对应于该代码的数据。

在工作表 1 中，如果此代码与 A 列中的代码匹配，我希望能够放置其中一个代码并让 VBA 从工作表 2 传输 B:H 行。

这是我到目前为止的程序，它传输行，但不是正确的行。

    Dim i As Integer
    Dim x As Integer
    Dim row As Integer
    Dim oldRow As Integer
    Dim found As Boolean
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Dim rng As Range, cell As Range, rng2 As Range, cell2 As Range

Set rng2 = ws2.Range("A1:A212")
Set rng = ws1.Range("A1:A212")

row = 1
oldRow = 1


For Each cell In rng
    row = row + 1

    For Each cell2 In rng2
        oldRow = oldRow + 1

        If cell.Value = cell2.Value Then
        row = row - 1
            ws1.Cells(row, 2) = ws2.Cells(oldRow, 2)
            ws1.Cells(row, 3) = ws2.Cells(oldRow, 3)
            ws1.Cells(row, 4) = ws2.Cells(oldRow, 4)
            ws1.Cells(row, 5) = ws2.Cells(oldRow, 5)
            ws1.Cells(row, 6) = ws2.Cells(oldRow, 6)
            ws1.Cells(row, 7) = ws2.Cells(oldRow, 7)
            ws1.Cells(row, 8) = ws2.Cells(oldRow, 8)
            found = True
        End If



    Next
    found = False
    oldRow = 1

Next

End Sub

感谢您的帮助，谢谢。

4

4 回答 4

0

你可以这样做将公式。在“Sheet1”单元格 B1 上并上下复制：

=IF(COUNTIF(Sheet2!$A:$A,$A1)=0,"",VLOOKUP($A1,Sheet2!$A:$H,COLUMN(B1),0))

如果它必须是一个宏，那么这样的东西应该适合你：

Sub tgr()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rngFound As Range
    Dim arrCodes As Variant
    Dim arrResults As Variant
    Dim varCode As Variant
    Dim ResultIndex As Long
    Dim cIndex As Long

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")

    arrCodes = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp)).Value
    If Not IsArray(arrCodes) Then Exit Sub  'No data
    ReDim arrResults(1 To UBound(arrCodes, 1), 1 To 7)

    For Each varCode In arrCodes
        ResultIndex = ResultIndex + 1
        Set rngFound = ws2.Columns("A").Find(varCode, , xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            For cIndex = 1 To UBound(arrResults, 2)
                arrResults(ResultIndex, cIndex) = WorksheetFunction.VLookup(varCode, ws2.Range("A:H"), cIndex + 1, False)
            Next cIndex
        End If
    Next varCode

    ws1.Range("B1").Resize(UBound(arrResults, 1), UBound(arrResults, 2)).Value = arrResults

End Sub
于 2013-10-10T20:17:30.797 回答
0

未经测试：

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range, f As Range, rng2 As Range
Dim c as range, cell as Range


Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = ws1.Range("A1:A212")
Set rng2 = ws2.Range("A1:A212")

row = 1
oldRow = 1


For Each cell In rng.Cells
    if len(cell.value)>0 Then
        Set f = rng2.Find(cell.Value, lookin:=xlvalues, lookat:=xlWhole)
        if not f is nothing then
            cell.offset(0,1).Resize(1,7).Value = _
               f.offset(0,1).resize(1,7).Value
        end if   
    end if   
Next cell
于 2013-10-10T20:12:34.777 回答
0

这需要在VBA中吗？还是您可以使用VLOOKUP工作表功能？因为这实际上是您试图从事物的声音中实现的目标。

您也可以VLOOKUP在 VBA 中使用Application.WorksheetFunction.VLookup

您的问题可能是因为您在循环开始而不是结束时递增row。oldRow所以第一次运行时，它们的值将是 2 而不是 1。您也可能不需要这样做，row = row - 1因为它令人困惑。

于 2013-10-10T20:14:41.043 回答
0

我会像这样更改代码：

Sub test()
    Dim i As Integer
    Dim n As Integer
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    'Cycles through the codes in sheet 1
    For i = 2 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).row Step 1
        For n = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).row Step 1
            If ws1.Cells(i, 1).Value = ws2.Cells(n, 1).Value Then
                ws1.Cells(i, 2).Value = ws2.Cells(n, 2).Value
                ws1.Cells(i, 3).Value = ws2.Cells(n, 3).Value
                ws1.Cells(i, 4).Value = ws2.Cells(n, 4).Value
                ws1.Cells(i, 5).Value = ws2.Cells(n, 5).Value
                ws1.Cells(i, 6).Value = ws2.Cells(n, 6).Value
                ws1.Cells(i, 7).Value = ws2.Cells(n, 7).Value
                ws1.Cells(i, 8).Value = ws2.Cells(n, 8).Value
            End If
        Next n
    Next i
End Sub
于 2013-10-10T20:25:31.530 回答