如何用VBA根据购买和消费明细做个客户剩余产品查询表

1148842862

2个表，1个是购买项目产品的表，1个是消费项目产品的表，这2个表的数据列不是相同的，字段不一样。
现在要做个随时可以查询的客户剩余产品项目明细表。

我想的逻辑是：先根据客户姓名筛选出这2张表的产品项目的值，然后将名称一致的数量列由购买表减去消费表的。然后将结果不等于0的项目名称和值显示出来。


这个用函数来写比较麻烦，而且我项目产品的名称特别多有几百个，这个表的数据量后期也会比较大，用函数写会很卡。想请教下大佬们用VBA可以实现吗？该怎么写，谢谢
还有一个小问题，我学VBA写了个客户姓名的自动联想输入的下拉菜单，但是那个代码只能是1个单元格或者1个区域，我想改为多个单元格不知道怎么改了，最好是录入表和个人信息表的客户姓名都能成为自动联想的下拉菜单，谢谢了

ykcbf1100

需求有点多啊。先做个记号。

3190496160

Sub 剩余查询()
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("购买预付")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "购买预付为空！": End
    ar = .Range("a1:i" & r)
End With
With Sheets("消费划扣")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    If rs < 2 Then MsgBox "消费划扣为空！": End
    br = .Range("a1:i" & rs)
End With
With Sheets("个人剩余信息")
    xm = .[a3]
    If xm = "" Then MsgBox "请输入要查询的客户名称！": End
    ReDim arr(1 To UBound(ar) + UBound(br), 1 To 4)
    For i = 2 To UBound(ar)
        If ar(i, 4) <> "" Then
            If ar(i, 4) = xm Then
                t = d(ar(i, 8))
                If t = "" Then
                    k = k + 1
                    d(ar(i, 8)) = k
                    t = k
                    For j = 6 To 8
                        arr(k, j - 5) = ar(i, j)
                    Next j
                End If
                arr(t, 4) = arr(t, 4) + ar(i, 9)
            End If
        End If
    Next i
    For i = 2 To UBound(br)
        If br(i, 4) <> "" Then
            If br(i, 4) = xm Then
                t = d(br(i, 8))
                If t = "" Then
                    k = k + 1
                    d(br(i, 8)) = k
                    t = k
                    For j = 6 To 8
                        arr(k, j - 5) = br(i, j)
                    Next j
                End If
                arr(t, 4) = arr(t, 4) - br(i, 9)
            End If
        End If
    Next i
    ReDim brr(1 To k, 1 To 4)
    For i = 1 To k
        If arr(i, 4) <> 0 Then
            n = n + 1
            For j = 1 To 4
                brr(n, j) = arr(i, j)
            Next j
        End If
    Next i
    .UsedRange.Offset(10) = Empty
    .[a11].Resize(n, UBound(arr, 2)) = brr
End With
MsgBox "ok!"
End Sub

3190496160

数据-.rar (90.53 KB, 下载次数: 10)

2024-8-22 13:26 上传

点击文件名下载附件

1148842862

3190496160 发表于 2024-8-22 13:26

多谢大佬，这个可以用，代码太多了，我慢慢研究去，就是这个我选择没有任何购买和消费的客户的时候，代码运行会显示下标越界，这也算是一种提示方法，但是直接显示空值是不是会更好呢？

3190496160

1148842862 发表于 2024-8-22 14:21
多谢大佬，这个可以用，代码太多了，我慢慢研究去，就是这个我选择没有任何购买和消费的客户的时候，代码 ...

if k="" then end