求助按指定条件显示正确的剩余数量

Justin-2016

求助按指定条件显示正确的剩余数量.zip (7.39 KB, 下载次数: 10)

2024-7-2 18:50 上传

点击文件名下载附件

小凡、、、

=IF(COUNTIF(A$2:A2,A2)=1,B2-C2,LOOKUP(,0/(A1:A$2=A2),D1:D$2)-C2)  公式可以解决

shiruiqiang

shiruiqiang

Sub test()
Dim arr
Dim dic
Set dic = CreateObject("scripting.dictionary")
arr = Sheets(1).[a1].CurrentRegion
For x = 2 To UBound(arr)
If Not dic.exists(arr(x, 1)) Then
dic(arr(x, 1)) = arr(x, 2) - arr(x, 3)
arr(x, 4) = dic(arr(x, 1))
Else
dic(arr(x, 1)) = dic(arr(x, 1)) - arr(x, 3)
arr(x, 4) = dic(arr(x, 1))
End If
Next
Sheets(1).[a1].CurrentRegion = arr
Beep


End Sub

lushang2018

Justin-2016

小凡、、、 发表于 2024-7-2 18:59
=IF(COUNTIF(A$2:A2,A2)=1,B2-C2,LOOKUP(,0/(A1:A$2=A2),D1:D$2)-C2)  公式可以解决

我想要用VBA解决

跨越时空

Sub test()
    Dim arr, d, mr%, i%
    Set d = CreateObject("Scripting.Dictionary")
    Sheet1.Activate
    mr = Cells(Rows.Count, 1).End(xlUp).Row
    Range("d2:d" & mr).ClearContents
    arr = Sheet1.UsedRange
    For i = 2 To UBound(arr)
        If d.Exists(arr(i, 1)) Then
            d(arr(i, 1)) = d(arr(i, 1)) - arr(i, 3)
            arr(i, 4) = d(arr(i, 1))
        Else
            d(arr(i, 1)) = arr(i, 2) - arr(i, 3)
            arr(i, 4) = d(arr(i, 1))
        End If
    Next
    [a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

跨越时空

Sub Test()
    Dim arr, d, mr%, i%
    Set d = CreateObject("Scripting.Dictionary")
    Sheet1.Activate
    mr = Cells(Rows.Count, 1).End(xlUp).Row
    Range("d2:d" & mr).ClearContents
    arr = Sheet1.UsedRange
    For i = 2 To UBound(arr)
        If d.Exists(arr(i, 1)) Then
            d(arr(i, 1)) = d(arr(i, 1)) - arr(i, 3)
            arr(i, 4) = d(arr(i, 1))
        Else
            d(arr(i, 1)) = arr(i, 2) - arr(i, 3)
            arr(i, 4) = d(arr(i, 1))
        End If
    Next
    [a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

跨越时空