两个工作数据匹配并复制匹配后数据的问题

清风竹-

liushilin 发表于 2024-9-23 18:36
你好，请问如果表一D列中的编码不是唯一的，也就是说有相同的编码，且我只匹配表一G列大于0值所在的行
...

请测试。。。

liushilin

清风竹- 发表于 2024-9-25 09:13
请测试。。。

你好，我想增加一个条件，就是表二P列单元格的值＝"甲单位"或者为空值时才进行数据引用。我将代码改了，但是运行出错了，能否帮忙再指导下。谢谢
Sub 提取数据()
Dim arr, i&
m = Sheet1.Cells(65536, 4).End(3).Row
arr = Sheet1.Range("d1:g" & m)

m2 = Sheet2.Cells(65536, "p").End(3).Row
arr2 = Sheet2.Range("b1:q" & m2)

ReDim brr(1 To UBound(arr), 1 To 7)
ReDim brr2(1 To UBound(arr), 1 To 6)
Set d = CreateObject("scripting.dictionary")


For i = 2 To UBound(arr2)

   If arr2(i, 16) = "甲单位" or arr2(i,16)="" Then    ' 这是我自己增加的代码，
        ss = arr2(i, 15)
        If d.Exists(ss) Then
            If arr2(i, 13) > brr(d(ss), 5) Then
                brr(d(ss), 5) = arr2(i, 13)
                brr(d(ss), 7) = i
            End If
        End If
    End If
Next i

    For i = 1 To d.Count
         For j = 1 To 4
           brr(i, j) = arr2(brr(i, 7), j)'增加代码后这行出错了
        Next
       brr(i, 6) = arr2(brr(i, 7), 16)
    Next

    For i = 2 To UBound(arr)
     If arr(i, 4) > 0 Then
        ss = arr(i, 1)
        If d.Exists(ss) Then
           For j = 1 To 6
               brr2(i - 1, j) = brr(d(ss), j)
           Next
      
       End If
     End If
    Next
Cells(2, "h").Resize(UBound(brr), 6) = brr2
End Sub

清风竹-

liushilin 发表于 2024-12-18 16:44
你好，我想增加一个条件，就是表二P列单元格的值＝"甲单位"或者为空值时才进行数据引用。我将代码改了， ...

我这里测试了一下，没问题。