VBA根据单据号从两个不同的sheet里筛选数据

Public Sub Filter()
' sheet1 是从乾坤里导出的总表
' sheet2 是自己维护的未开票的提单号
' 此函数是用来自动筛选匹配提单号,如果已经未开票的提单号则在sheet1,则sheet1的S列的值为 1 ,否则为 0
' 只要把已经开票的提单号拷贝到sheet2 的E列就可以了,sheet1 从乾坤导出来的格式不变化

 

    'If Workbooks(1).Worksheets("sheet1") Is Nothing Then
       'MsgBox "sheet1不存在"
    'Else
       'MsgBox "sheet1存在"
    'End If
   
   
       
       
    Dim Sheet1RowCount As Integer
    Dim Sheet2RowCount As Integer
    Sheet1RowCount = Sheet1.UsedRange.Rows.Count  '乾坤导出的excel
    Sheet2RowCount = Sheet2.UsedRange.Rows.Count  '自己维护的已经开票的excel
    Dim SourceData As String
    Dim TargetData As String
    Dim IsFound As String
    IsFound = "NO"   '没有匹配到

    Dim i As Integer   '外循环的次数
    Dim j As Integer   '内循环的次数
    Dim k As Integer
    Dim p As Integer
   
   
   
    '不知道为啥一次循环删除不了所有的空格
    For p = 1 To 20
        Sheet2RowCount = Sheet2.UsedRange.Rows.Count  '自己维护的已经开票的excel
        For k = 1 To Sheet2RowCount
            If RTrim(LTrim(Sheet2.Cells(k, 5).Value)) = "" Then
                Sheet2.Rows(k).Delete
            End If
        Next
    Next

   

   
    Sheet2RowCount = Sheet2.UsedRange.Rows.Count  '自己维护的已经开票的excel
   
    For i = 4 To Sheet1RowCount   '乾坤导出的excel
        SourceData = Sheet1.Cells(i, 5).Value
        For j = 1 To Sheet2RowCount
           TargetData = Sheet2.Cells(j, 5).Value  '自己维护的已经开票的excel
           If SourceData = TargetData Then
                 Sheet1.Cells(i, 19).Value = 1   '匹配成功
                 IsFound = "YES"
           Else
                 Sheet1.Cells(i, 19).Value = 0    '匹配失败
                 IsFound = "NO"
           End If
           If IsFound = "YES" Then
                Exit For
           End If
        Next
    Next
   
   
    '匹配成功后拷贝到sheet3,sheet4
    Dim r As Integer
    Dim s As Integer
    r = 0
    s = 0
   
   
    For i = 4 To Sheet1RowCount   '乾坤导出的excel
        If Sheet1.Cells(i, 19) = 1 Then
            r = r + 1
            Sheet1.Rows(i).Copy Sheet3.Rows(r)
        Else
            s = s + 1
            Sheet1.Rows(i).Copy Sheet4.Rows(s)
        End If
    Next
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
   

 

你可能感兴趣的:(VBA)