Option Explicit
Dim dicOpenBook As New Scripting.Dictionary
Public Function TangTocCode(TanToc As Boolean)
With Application
.ScreenUpdating = Not (TanToc)
.EnableEvents = Not (TanToc)
.Calculation = IIf(TanToc, xlCalculationManual, xlCalculationAutomatic)
End With
End Function
Public Function SheetExists(book As Workbook, sheetName As String) As Boolean
Dim sht As Worksheet
SheetExists = False
For Each sht In book.Worksheets
If sheetName = sht.Name Then
SheetExists = True
Exit Function
End If
Next
End Function
Public Function BookExists(bookName As String) As Boolean
Dim book As Workbook
BookExists = False
For Each book In Workbooks
If bookName = book.Name Then
BookExists = True
Exit Function
End If
Next
End Function
Public Function OpenSheet(book As Workbook, sheetName As String) As Worksheet
Set OpenSheet = Nothing
If SheetExists(book, sheetName) Then
Set OpenSheet = book.Worksheets(sheetName)
End If
End Function
Public Sub CloseBookIfOpenByMe(book As Workbook, Optional saveMe As Boolean = False)
If dicOpenBook.Exists(book.Name) Then
Exit Sub
End If
CloseBook book, saveMe
End Sub
Public Sub CloseBook(book As Workbook, Optional saveMe As Boolean = False)
Application.DisplayAlerts = False
If saveMe Then
book.Save
End If
book.Close
Set book = Nothing
Application.DisplayAlerts = True
End Sub
Public Function OpenBook(bookPath As String, bookFile As String, Optional text As Boolean = False) As Workbook
Set OpenBook = Nothing
If BookExists(bookFile) Then
Set OpenBook = Workbooks(bookFile)
If Not dicOpenBook.Exists(bookFile) Then dicOpenBook.Add bookFile, True
Exit Function
End If
If dicOpenBook.Exists(bookFile) Then dicOpenBook.Remove bookFile
On Error GoTo End_
If text Then
Call Workbooks.OpenText(bookPath & "\" & bookFile, Origin:=65001, Tab:=True, Comma:=False, Semicolon:=False)
Set OpenBook = Workbooks(Workbooks.count)
Else
Set OpenBook = Workbooks.Open(bookPath & "\" & bookFile & ".xlsx")
End If
ThisWorkbook.Activate
End_:
End Function
Sub TongHopDienTro()
Dim opBook As Workbook, opSht As Worksheet, book As Workbook, sht As Worksheet
Dim r As Long, k As Long, c As Long, n As Long
Dim Data() As Variant, Res() As Variant, sKey As Variant, DienTro As String
Dim Cac_forder_theo_May_Thang_Tuan As String 'Em có các forder theo máy/tháng/tu?n/SMP0000.CSV
On Error GoTo End_sub
TangTocCode True
Set book = ThisWorkbook
Set sht = book.Worksheets("TH")
Const sFile As String = "SMP0000.CSV"
Cac_forder_theo_May_Thang_Tuan = ThisWorkbook.Path
DienTro = "Gi" & ChrW(225) & " tr" & ChrW(7883) & " " & ChrW(273) & "i" & ChrW(7879) & "n tr" & ChrW(7903)
Const ConSoMax As Integer = 6
Set opBook = OpenBook(Cac_forder_theo_May_Thang_Tuan, sFile, True)
If opBook Is Nothing Then
MsgBox "CSV file is invalid!", vbCritical
GoTo End_sub
End If
Set opSht = OpenSheet(opBook, "SMP0000")
If opSht Is Nothing Then
MsgBox "SMP0000 sheet is invalid!", vbCritical
GoTo End_sub
End If
With opSht
r = .Cells(.Rows.count, "A").End(xlUp).Row
If r < 2 Then Exit Sub
Data = .Range("A2").Resize(r - 1, 26)
End With
Call CloseBookIfOpenByMe(opBook, False)
ReDim Res(1 To UBound(Data, 1), 1 To ConSoMax + 2)
Dim Dic As New Scripting.Dictionary
k = 2
For r = 1 To UBound(Data, 1)
If Data(r, 6) < ConSoMax Then
sKey = Data(r, 6)
If Not Dic.Exists(sKey) Then
k = k + 1
Dic.Add sKey, k
Res(1, k) = DienTro & " " & sKey
End If
End If
Next r
k = 1
For r = 1 To UBound(Data, 1)
sKey = Data(r, 2) & "|" & Data(r, 3)
c = Dic.Item(Data(r, 6))
If c Then
If Not Dic.Exists(sKey) Then
k = k + 1
Dic.Add sKey, k
Res(k, 1) = Data(r, 2)
Res(k, 2) = Data(r, 3)
Res(k, c) = Data(r, 12)
Else
n = Dic.Item(sKey)
If Data(r, 12) > Res(n, c) Then
Res(n, c) = Data(r, 12)
End If
End If
End If
Next r
sht.Cells.ClearContents
sht.Range("A1").Resize(UBound(Data, 1), ConSoMax + 2).Value = Res
TangTocCode False
MsgBox "Done!", vbInformation
GoTo Exit_Sub
End_sub:
TangTocCode False
If Err <> 0 Then
MsgBox "Error: " & Err.Description, vbCritical
End If
Exit_Sub:
End Sub
