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