初学字典，请码老师给调试下

沈默00

         初学字典，还在照驴子画马，可还是有问题，：1查询条件里除了姓名关键字，卡类型好像不行；2：最后写入查询结果时两次转置后数据错误。。。。。请老师们帮调试并优化一下。

沈默00

怎么现在的贴都要审核很长时间

tanglf188

我主题里有字典用法，可以参考一下，你的代码里字典项转置没有问题
FILTER函数用到的参数要在一维固定数组里完成,你的代码里brr虽然只有一列，但是个二维数组，用FILTER函数取不到数。

沈默00

tanglf188 发表于 2023-6-15 08:53
我主题里有字典用法，可以参考一下，你的代码里字典项转置没有问题
FILTER函数用到的参数要在一维固定数组 ...

可我在调试的时候发现前面都有取出来 ，一直到frr的时候都是对的，见图片上标注的地方。麻烦老师再看下

半百

ykcbf1100

你这个模糊查询没必要用字典，用字典的话应该更麻烦。

3190496160

Sub 会员消费查询()
Dim d, i%, arr, brr()
Dim rn As Range
Set d = CreateObject("scripting.dictionary")
arr = Sheets("明细表").Range("a1").CurrentRegion
With Sheets("查询")
    mc = .[b2]
    zd = .[c2]
    If mc = "" Then MsgBox "请选择查询项目！": End
    If zd = "" Then MsgBox "请输入关键字！": End
    Set rn = Sheets("明细表").Rows(1).Find(mc, , , , , , 1)
    If rn Is Nothing Then MsgBox "明细表中没有" & mc & "列字段": End
    y = rn.Column
    ReDim brr(1 To UBound(arr), 1 To 4)
    For i = 2 To UBound(arr)
        If Trim(arr(i, y)) <> "" Then
            If InStr(arr(i, y), zd) > 0 Then
                t = d(Trim(arr(i, y)))
                If t = "" Then
                    k = k + 1
                    d(Trim(arr(i, y))) = k
                    t = k
                    For j = 2 To 4
                        brr(k, j - 1) = arr(i, j)
                    Next j
                End If
                brr(t, 4) = brr(t, 4) + arr(i, 5)
            End If
        End If
    Next i
    If k = "" Then MsgBox "没有符合条件的数据！": End
    .UsedRange.Offset(4) = Empty
    .[a5].Resize(k, UBound(brr, 2)) = brr
End With
End Sub

3190496160

3190496160

仅供参考
会员卡消费统计.rar (20.32 KB, 下载次数: 10)

2023-6-15 10:50 上传

点击文件名下载附件

沈默00

半百 发表于 2023-6-15 10:00

+1 也是一样的，转置后没有数据取出来