VBA 根据日期跨表查询

rayhen

日期查询在 C2
SHEET1 绿色C4:D13是结果

3190496160

Sub 查询()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
With Sheets("sheet2")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    y = .Cells(2, Columns.Count).End(xlToLeft).Column
    ar = .Range(.Cells(2, 2), .Cells(r, y))
End With
With Sheets("sheet1")
    rq = .[c2]
    If rq = "" Then MsgBox "请选择查询日期！": End
    If Not IsDate(rq) Then MsgBox "请输入标准日期!": End
    ReDim br(1 To UBound(ar), 1 To 2)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            If IsDate(ar(i, 1)) Then
                If ar(i, 1) = rq Then
                    For j = 2 To UBound(ar, 2)
                        If Trim(ar(i, j)) <> "" Then
                            If IsNumeric(ar(i, j)) Then
                                n = n + 1
                                br(n, 1) = ar(1, j)
                                br(n, 2) = ar(i, j)
                            End If
                        End If
                    Next j
                End If
            End If
        End If
    Next i
    If n = "" Then MsgBox "没有符合条件的数据！": End
    .UsedRange.Offset(3) = Empty
    .[b4].Resize(n, UBound(br, 2)) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

20230501.rar (19.08 KB, 下载次数: 28)

2023-5-2 09:37 上传

点击文件名下载附件

rayhen

感谢老师热心帮忙问题解决了