过滤器过滤能完全匹配的数据标记颜色

Public brr, brr_ykfp
Private Sub initData()
    With Sheets("历史数据")
        .Cells.ClearContents
        .Cells.Interior.ColorIndex = 0
        .[d1] = "开票日期"
    End With
End Sub

Sub main()
    Dim rng As Range
    Application.ScreenUpdating = False
    Call initData
    Call getData
    Set d = CreateObject("scripting.dictionary")
    For x = 2 To UBound(brr_ykfp)
        s = brr_ykfp(x, 1) & "," & brr_ykfp(x, 3)
        d(s) = brr_ykfp(x, 2)
    Next
    With Sheets("历史数据")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For x = 2 To lastRow
            ss = .Cells(x, 3).Value & "," & .Cells(x, 2).Value
            If d.exists(ss) Then
                .Cells(x, 4) = d(ss)
                If rng Is Nothing Then
                    Set rng = Cells(x, "c")
                Else
                    Set rng = Union(rng, Cells(x, "c"))
                End If
            End If
        Next
        If Not rng Is Nothing Then rng.Interior.ColorIndex = 3
    End With
    Call dataFormat
    mb.closeMsgboxAfter1SecondM3
    Application.ScreenUpdating = True
End Sub

Private Sub dataFormat()
    With Sheets("历史数据")
        .Range("a1").CurrentRegion.Borders.LineStyle = 1
    End With
End Sub

Private Sub getData()
    path = ThisWorkbook.path & "\"
    p = pathSelected(path)
     If p = "" Then End
    Application.ScreenUpdating = False
    p_ykfp = pathSelected_ykfp(path)
    If p_ykfp = "" Then End
    With GetObject(p_ykfp)
        brr_ykfp = .Sheets("sheet1").[a1].CurrentRegion
        .Close False
    End With
    With GetObject(p)
        brr = .Sheets("historydetail730").[a1].CurrentRegion
        .Close False
    End With
    With Sheets("历史数据")
        .Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    End With
 
    '    With Sheets("已开票数据")
    '        .Range("a1").Resize(UBound(brr_ykfp), UBound(brr_ykfp, 2)) = brr_ykfp
    '    End With
    Application.ScreenUpdating = True
End Sub

Private Function pathSelected(path) '文件
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "文本文件", "*.CSV"  '设置过滤器
        .InitialFileName = path
        .Title = "historydetail表格"
        .AllowMultiSelect = False
        If .Show Then p = .SelectedItems(1) Else: Exit Function
    End With
    pathSelected = p
End Function

Private Function pathSelected_ykfp(path) '文件
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "文本文件", "*.xls;*.xlsx" '设置过滤器
        .InitialFileName = path
        .Title = "已开发票数据导出表格"
        .AllowMultiSelect = False
        If .Show Then p = .SelectedItems(1) Else: Exit Function
    End With
    pathSelected_ykfp = p
End Function

 

posted @ 2022-11-18 08:42  依云科技  阅读(24)  评论(0)    收藏  举报