跨工作表比对数后引用数据问题 下标越界

孤独是种美

问题在哪呀？

孤独是种美

代码sheet3里，谢谢！

3190496160

Sub cs()
Dim i%, r% '定义变量
Dim arr1, arr2 '定义数组
arr1 = Sheets("sheet1").[a1].CurrentRegion '表1数据赋值给数组arr1
Sheets("sheet2").[a1].Resize(1, UBound(arr1, 2)) = arr1
arr2 = Sheets("sheet2").[a1].CurrentRegion '表2数据赋值给数组arr2
r = 1
For r = 1 To UBound(arr2) '可以看成表2的行数
    For i = 1 To UBound(arr1) '可以看成表1的行数
        If arr2(r, 1) = arr1(i, 1) Then '可以看成如果表1和表2各自的第1列数据有一样的
            For j = 2 To UBound(arr1, 2)
                arr2(r, j) = arr1(i, j)
            Next j
        End If
    Next i
Next r
Sheets("sheet2").[a1].Resize(UBound(arr2), UBound(arr2, 2)) = arr2 '把更新后的数组arr2复制到表2
End Sub

孤独是种美

3190496160 发表于 2020-10-26 09:34
Sub cs()
Dim i%, r% '定义变量
Dim arr1, arr2 '定义数组

谢谢，问题已解决，问题在哪呢？ 才开始学搞不懂！

3190496160

Sub 字典法()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
arr1 = Sheets("sheet1").[a1].CurrentRegion '表1数据赋值给数组arr1
Sheets("sheet2").[a1].Resize(1, UBound(arr1, 2)) = arr1
arr2 = Sheets("sheet2").[a1].CurrentRegion '表2数据赋值给数组arr2
For i = 2 To UBound(arr1)
    If Trim(arr1(i, 1)) <> "" Then
        d(Trim(arr1(i, 1))) = i
    End If
Next i
For i = 1 To UBound(arr2) '可以看成表2的行数
    If Trim(arr2(i, 1)) <> "" Then
        m = d(Trim(arr2(i, 1)))
        If m <> "" Then
            For j = 2 To UBound(arr1, 2)
                arr2(i, j) = arr1(m, j)
            Next j
        End If
    End If
Next i
Sheets("sheet2").[a1].CurrentRegion = arr2
End Sub

孤独是种美

3190496160 发表于 2020-10-26 09:38
Sub 字典法()
Dim d As Object
Set d = CreateObject("scripting.dictionary")

谢谢啦，同样可以解决问题，就是不知道我的问题在哪里？

3190496160

孤独是种美 发表于 2020-10-26 09:41
谢谢啦，同样可以解决问题，就是不知道我的问题在哪里？

sheet2中你只有A列有数据，而你却使用  arr2 = Sheets("sheet2").[a1].CurrentRegion '表2数据赋值给数组arr2来构建数组，所以实际上数组arr2只有一列，而你最终是赋值多列的，肯定下标越界了呀，使用者这句Sheets("sheet2").[a1].Resize(1, UBound(arr1, 2)) = arr1把表1的列标题赋值到表2在构建数组

孤独是种美

3190496160 发表于 2020-10-26 09:54
sheet2中你只有A列有数据，而你却使用  arr2 = Sheets("sheet2").[a1].CurrentRegion '表2数据赋值给数组 ...

好的，谢谢啦，刚开始学，还不完全明白