帮忙写下查询条件，谢谢坛友

zhangzhezy

卡到这了，问题在附件里

Sub SZchaxun()
'收支查询
    Dim d, ar, arr, n&, m%, i&, j%
    Set d = CreateObject("Scripting.Dictionary")
    Sheets("收支查询").Range("B6:Q999").ClearContents
    ar = Sheets("收支查询").[A1:Q999]
    br = Sheets("收支查询").[A6:Q999]
    arr = Sheets("根数据").Range("A1:YN" & Sheets("根数据").[A36656].End(3).Row)
    For i = 2 To UBound(ar, 2)
        d(ar(5, i)) = UBound(arr, 2)
    Next
    For i = 1 To UBound(arr)
        If i = 1 Then
            For j = 1 To UBound(arr, 2)
                If d.exists(arr(1, j)) Then d(arr(1, j)) = j
            Next
        Else
            If (ar(2, 5) = (arr(i, 10)) Or ar(2, 5) = "") And (ar(2, 7) = arr(i, 3) Or ar(2, 7) = "") And (ar(2, 9) _
                   = Month(arr(i, 16)) Or ar(2, 9) = "") And (IIf(ar(2, 11) = "未收金额", arr(i, 38) <> "", _
                    ar(2, 11) = arr(i, 38)) Or ar(2, 11) = "") Then

                   '未收金额在"根数据表"" 38列,应付金额在"根数据表" 25列,怎么在上面的代码里添加应付条件跟未收应付条件

                   '未收应付条件为在满足"收支查询表"符合E2、G2、I2、K2,"根数据表"下25列、38列任意一个不为空的数据

            n = n + 1: m = 1
            For Each x In d.items
                m = m + 1
                br(n, m) = arr(i, x)
            Next
        End If
        End If

    Next
    Sheets("收支查询").[A6:Q999] = br
End Sub

liulang0808

整体需求不是太明白，按照楼主这段描述，感觉先来确定列的位置
if "未收金额"=[j2] then
cl= 38
else
endif

按照此样式，先将对应的列获取了，供参考

fanyoulin

vba的 if 不能使用文本来动态组合判断条件，所以这个问题用 SQL更容易，输出也更简单；
一会我给你写个SQL的范本

fanyoulin

用SQL写好了，文件中有说明；

3190496160

Sub chaxun()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Set d = CreateObject("Scripting.Dictionary")
ar = Sheets("根数据").Range("A1:YN" & Sheets("根数据").[A36656].End(3).Row)
With Sheets("收支查询")
    rr = Array(.[e2], 10, .[g2], 3, .[i2], 16, .[k2], 25 & "|" & 38)
    .UsedRange.Offset(5) = Empty
    .UsedRange.Offset(5).Borders.LineStyle = 0
    br = .Range("a5:q" & UBound(ar) + 5)
    For j = 1 To UBound(br, 2)
        If Trim(br(1, j)) <> "" Then
            d(Trim(br(1, j))) = j
        End If
    Next j
    ReDim mr(1 To 4, 1 To 2)
    For i = 0 To UBound(rr) Step 2
        If Trim(rr(i)) <> "" Then
            n = n + 1
            mr(n, 1) = rr(i)
            If i < 5 Then
                mr(n, 2) = rr(i + 1)
            Else
                If rr(i) = "应付金额" Then
                    mr(n, 2) = 25
                ElseIf rr(i) = "未收金额" Then
                    mr(n, 2) = 38
                Else
                    mr(n, 2) = 25 & "|" & 38
                End If
            End If
        End If
    Next i
    If n = "" Then MsgBox "请输入查询条件！": End
    m = 1
    For i = 2 To UBound(ar)
        k = 0
        For s = 1 To n
            zd = mr(s, 1)
            lh = mr(s, 2)
            If InStr(lh, "|") = 0 Then
                If lh = 16 Then
                    zf = Val(Month(ar(i, lh)))
                Else
                    zf = ar(i, lh)
                End If
                If lh = 25 Or lh = 38 Then
                    If Trim(ar(i, lh)) <> "" Then
                        k = k + 1
                    End If
                Else
                    If zf = zd Then
                        k = k + 1
                    End If
                End If
            Else
                yr = Split(lh, "|")
                zf_1 = Trim(ar(i, yr(0)))
                zf_2 = Trim(ar(i, yr(1)))
                If zf_1 <> "" Or zf_2 <> "" Then
                    k = k + 1
                End If
            End If
        Next s
        If k = n Then
            m = m + 1
            For j = 1 To UBound(ar, 2)
                llh = d(Trim(ar(1, j)))
                If llh <> "" Then
                    br(m, llh) = ar(i, j)
                End If
            Next j
        End If
    Next i
    If m = 1 Then MsgBox "没有符合条件的数据！": End
    .[a5].Resize(m, UBound(br, 2)) = br
    .[a5].Resize(m, UBound(br, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

收支表.rar (546.81 KB, 下载次数: 10)

2023-5-31 12:33 上传

点击文件名下载附件

3190496160

vba完成的，思路可能跟你的不一样，供参考

zhangzhezy

老师们看看我这么写有没有问题，有什么弊端
纯新手，还请指教

Sub SZchaxun()
'收支查询
    Dim d, ar, arr, n&, m%, i&, j%
    Set d = CreateObject("Scripting.Dictionary")
    Sheets("收支查询").Range("B6:Q999").ClearContents
    ar = Sheets("收支查询").[A1:Q999]
    br = Sheets("收支查询").[A6:Q999]
    arr = Sheets("根数据").Range("A1:YN" & Sheets("根数据").[A36656].End(3).Row)
    For i = 2 To UBound(ar, 2)
        d(ar(5, i)) = UBound(arr, 2)
    Next
    For i = 1 To UBound(arr)
        If i = 1 Then
            For j = 1 To UBound(arr, 2)
                If d.exists(arr(1, j)) Then d(arr(1, j)) = j
            Next
        Else
            If (ar(2, 5) = (arr(i, 10)) Or ar(2, 5) = "") _
                And (ar(2, 7) = arr(i, 3) Or ar(2, 7) = "") _
                And (ar(2, 9) = Month(arr(i, 16)) Or ar(2, 9) = "") _
                And (IIf(ar(2, 11) = "应付金额", arr(i, 25) <> 0, ar(2, 11) = arr(i, 25)) _
                    Or (IIf(ar(2, 11) = "未收金额", arr(i, 38) <> 0, ar(2, 11) = arr(i, 38)) _
                    Or (IIf(ar(2, 11) = "未收应付", arr(i, 38) <> 0 Or arr(i, 25) <> 0, ar(2, 11) = arr(i, 38)) _
                    Or ar(2, 11) = ""))) Then
                  
            n = n + 1: m = 1
            For Each x In d.items
                m = m + 1
                br(n, m) = arr(i, x)
            Next
        End If
        End If
        
    Next
    Sheets("收支查询").[A6:Q999] = br
    MsgBox "完成"
End Sub

zhangzhezy

发重了，按快了2

zhangzhezy

发重了，按快了3