VBA求助：查找同列单元格中的数据是否与最后一个数据相等，如相等则返回另一个值.

xiashuming1

VBA求助（逻辑说明）：查找同列单元格中的数据是否与最后一个数据相等，如相等则返回指定在另一列中（ROW+1)的数据，显示在指定的区域中（M3:S),VBA执行到H列最后一个空值时停止。例：B列最后一个数据在B5292，值是6，向上查找到同列有2个6分别在B5284和B5278,刚返回对应在H列中(ROW+1)的数值分别是17和5备注：考虑到运行速度，请用数组赋值的方式，请您赐教，非常感谢！
请大家看看，下面的VBA哪里有问题，因为运行不了
Dim i&, j&, rr, r, arr, brr, crr, drr
    r = Cells(Rows.Count, 8).End(3).Row
    Range("B3:H" & r ) = crr
    arr = Range("H3:H" & r)
    brr = Range("B" & r  & ":B" & r )
    crr = Range("B3:H" & r)
        For j = 1 To 7
        For i = 1 To r - 3
            If brr(1, j) = crr(i, j) Then drr(i, j) = arr(i, 1)
        Next
        Next
    Range("DM3:DS" & r) = drr

End Sub

wodewan

'结果放在U列
Sub test()
Dim arr, i&, j&
arr = Sheets("112233").[b5292].CurrentRegion
For j = 1 To UBound(arr, 2)
    For i = 1 To UBound(arr) - 1
        If arr(i, j) = arr(UBound(arr), j) Then
            arr(i, j) = arr(i + 1, UBound(arr, 2))
        Else
            arr(i, j) = Empty
        End If
    Next
    arr(UBound(arr), j) = Empty
Next
With Sheets("112233").[U5292].Offset(2 - UBound(arr), 0)
    .Resize(UBound(arr), UBound(arr, 2)).ClearContents
    .Resize(UBound(arr), UBound(arr, 2)) = arr
End With
End Sub

xiashuming1

谢谢，，还得烦请修改一下VBA，当有数据新增的时候，结果就出错

wodewan

xiashuming1 发表于 2020-2-7 11:49
谢谢，，还得烦请修改一下VBA，当有数据新增的时候，结果就出错

'这样试试?
Sub test()
Dim arr, i&, j&, r
With Sheets("112233")
r = .Range("b" & Rows.Count).End(3).Row
arr = .Range("b" & r).CurrentRegion
End With
For j = 1 To UBound(arr, 2)
    For i = 1 To UBound(arr) - 1
        If arr(i, j) = arr(UBound(arr), j) Then
            arr(i, j) = arr(i + 1, UBound(arr, 2))
        Else
            arr(i, j) = Empty
        End If
    Next
    arr(UBound(arr), j) = Empty
Next
With Sheets("112233").Range("u" & r).Offset(2 - UBound(arr), 0)
    .Resize(UBound(arr), UBound(arr, 2)).ClearContents
    .Resize(UBound(arr), UBound(arr, 2)) = arr
End With
End Sub

xiashuming1

显示“运行时错误1004”，无法对合并单元格执行此操作

xiashuming1

wodewan 发表于 2020-2-7 12:45
'这样试试?
Sub test()
Dim arr, i&, j&, r

烦表帮我看看，这样做哪里出问题了，谢谢
Dim i&, j&, rr, r, arr, brr, crr, drr
    r = Cells(Rows.Count, 8).End(3).Row
    Range("B3:H" & r ) = crr
    arr = Range("H3:H" & r)
    brr = Range("B" & r  & ":B" & r )
    crr = Range("B3:H" & r)
        For j = 1 To 7
        For i = 1 To r - 3
            If brr(1, j) = crr(i, j) Then drr(i, j) = arr(i, 1)
        Next
        Next
    Range("DM3:DS" & r) = drr

End Sub

wodewan

xiashuming1 发表于 2020-2-7 13:41
显示“运行时错误1004”，无法对合并单元格执行此操作

我这边测试的没说明问题，给个附件你吧，猜测是你写说明的合并单元格的问题