从基础数据中查询并标注

pop2009

liulang0808 发表于 2020-10-16 13:30
Sub 按钮1_Click()
    If Len()  4 Then
        MsgBox "b1单元格数据不符合要求"

谢谢版主的支持。

笨鸟飞不高

pop2009 发表于 2020-10-16 13:34
收到，谢谢。

今天的论坛又有点卡！！！

pop2009

liulang0808 发表于 2020-10-16 13:24
Sub 按钮1_Click()
    If Len()  4 Then
        MsgBox "b1单元格数据不符合要求"

版主，请帮忙又有新的需求了，谢谢。

pop2009

liulang0808 发表于 2020-10-16 13:23
附件内容供参考。。。。。。

版主，请帮忙领导又有新的需求了，谢谢。

pop2009

liulang0808 发表于 2020-10-16 13:30
Sub 按钮1_Click()
    If Len()  4 Then
        MsgBox "b1单元格数据不符合要求"

版主您好，感谢上次的支持，最近有新的业务导致查询时需要2个条件，请您多多帮忙，谢谢。
请见附件。

pop2009

liulang0808 发表于 2020-10-16 13:30
Sub 按钮1_Click()
    If Len()  4 Then
        MsgBox "b1单元格数据不符合要求"

版主您好，感谢上次的支持，最近有新的业务导致查询时需要2个条件，请您多多帮忙，谢谢。
请见附件。

liulang0808

Sub 按钮1_Click()
    If Len([b1]) <> 4 Then
        MsgBox "b1单元格数据不符合要求"
        Exit Sub
    End If
    ActiveSheet.UsedRange.Offset(2).ClearContents
    arr = Sheets("原始数据").UsedRange
    r = 0
    For j = 2 To UBound(arr)
        If Right(arr(j, 5), 4) = [b1] & "" Then
            r = r + 1
            For i = 1 To UBound(arr, 2)
                arr(r, i) = arr(j, i)
            Next i
        End If
    Next j
    If r > 0 Then
        r1 = 0
        If VBA.IsDate([d1]) Then
            For i = 1 To r
                If CDate([d1]) = CDate(arr(i, 6)) Then
                    r1 = r1 + 1
                    For j = 1 To UBound(arr, 2)
                        arr(r1, j) = arr(i, j)
                    Next j
                End If
            Next i
            If r1 > 0 Then
                [a3].Resize(r1, 6) = arr
            End If
        Else
            [a3].Resize(r, 6) = arr
        End If
    End If
End Sub
Sub 按钮2_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("原始数据").UsedRange
   
    Application.ScreenUpdating = False
    For j = 3 To Cells(Rows.Count, 5).End(3).Row
        d(Cells(j, 5) & CDate(Cells(j, 6))) = ""
    Next j
    For j = 2 To UBound(arr)
        If d.exists(arr(j, 5) & CDate(arr(j, 6))) Then arr(j, 7) = "已标注"
    Next j
     Sheets("原始数据").UsedRange = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。。

pop2009

liulang0808 发表于 2021-3-2 13:21
附件内容供参考。。。。。。

太感谢了，很强大，很高效，谢谢！

pop2009

liulang0808 发表于 2020-10-16 13:24
Sub 按钮1_Click()
    If Len()  4 Then
        MsgBox "b1单元格数据不符合要求"

再请教一下，
如果用您第一组代码，如何实现2个条查询，标注，谢谢！