Sub BayPlan_Check()
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).[c4].Resize(Cells(Rows.Count, 1).End(xlUp).ROW - 14, 1)
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, 1)
dic(arr(i, 1)) = 0
Next i
'舱单字典
For i = 1 To UBound(brr, 1)
dic1(brr(i, 1)) = 0
Next i
'舱单无
For i = 1 To UBound(arr, 1)
If Not dic1.exists(arr(i, 1)) Then
dic2(arr(i, 1)) = 0
End If
Next i
'船图无
For i = 1 To UBound(brr, 1)
If Not dic.exists(brr(i, 1)) Then
dic3(brr(i, 1)) = 0
End If
Next i
Workbooks.Add
Set MyBook2 = ActiveWorkbook
MyBook2.Sheets(1).Name = "BayPlan Check Result"
MyBook2.Sheets(1).Range("a1:d1") = Array("舱单无_BL", "舱单无_Container", "船图无_BL", "船图无_Container")
Range("b2").Resize(dic2.Count) = Application.Transpose(dic2.Keys)
Range("d2").Resize(dic3.Count) = Application.Transpose(dic3.Keys)
Cells.EntireColumn.AutoFit
Stop
End Sub
vba_bayplan_check02
最新推荐文章于 2024-07-19 14:27:26 发布