Sub BayPlanCheck()
arr = Selection
Dim MyBook1, MyBook2 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select A File"
.InitialFileName = "C:\TXT"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Text File", "*.txt"
.Filters.Add "EXCEL File", "*.xlsx; *.xls", 1
.Filters.Add "All File", "*.*", 1
If .Show Then
.ButtonName = "Select Me"
Set ipath = .SelectedItems
End If
End With
If IsEmpty(ipath) Then Exit Sub
ipath = ipath(1)
Set MyBook1 = Workbooks.Open(ipath)
brr = MyBook1.Sheets(1).[b4].Resize(Cells(Rows.Count, 1).End(xlUp).ROW - 14, 2)
crr = MyBook1.Sheets(1).[a1]
MyBook1.Close
Dim dic, dic1, dic2, dic3
Set dic = CreateObject("scripting.dictionary")
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
Set dic3 = CreateObject("scripting.dictionary")
'船图字典
For i = 1 To UBound(arr)
dic(arr(i, 1)) = 0
Next i
'舱单字典
For i = 1 To UBound(brr)
If brr(i, 1) = "" Then
brr(i, 1) = brr(i - 1, 1)
End If
dic1(brr(i, 2)) = brr(i, 1)
Next i
'舱单无
For i = 1 To UBound(arr)
If Not dic1.exists(arr(i, 1)) Then
dic2(arr(i, 1)) = 0
End If
Next i
'船图无
For i = 1 To UBound(brr)
If Not dic.exists(brr(i, 2)) Then
dic3(brr(i, 2)) = brr(i, 1)
End If
Next i
Workbooks.Add
Set MyBook2 = ActiveWorkbook
MyBook2.Sheets(1).Name = "BayPlan Check Result"
MyBook2.Sheets(1).Range("a1:d1") = Array("舱单无_Container", "舱单无_BL", "船图无_Container", "船图无_BL")
MyBook2.Sheets(1).Range("f1") = crr
If dic2.Count <> 0 Then
Range("a2").Resize(dic2.Count) = Application.Transpose(dic2.Keys)
End If
If dic3.Count <> 0 Then
Range("c2").Resize(dic3.Count) = Application.Transpose(dic3.Keys)
Range("d2").Resize(dic3.Count) = Application.Transpose(dic3.Items)
End If
Cells.EntireColumn.AutoFit
Range("a1:f1").Interior.ColorIndex = 36
MsgBox "Done"
End Sub
07-19
07-19
“相关推荐”对你有帮助么?
-
非常没帮助
-
没帮助
-
一般
-
有帮助
-
非常有帮助
提交