Xin chào HieuCD,
Chỉnh lại cột
Sub GPE_2()
' HieuCD
Dim Res(), DuLieu(), TongHop()
Dim khStr As String, iKey As String
Dim i As Long, ik As Long, j As Long, sCol As Long, jCol As Long
Dim Ngay As Date
With Sheets("DU_LIEU")
i = .Range("E1000000").End(xlUp).Row
DuLieu = .Range("E6:BA" & i).Value
Ngay = .Range("D2").Value
End With
With Sheets("TONG_HOP")
i = .Range("B8").End(xlDown).Row
sCol = .Range("AAA8").End(xlToLeft).Column
On Error Resume Next
jCol = Application.Match(Ngay, .Range("A8").Resize(, sCol).Value, 0)
On Error GoTo 0
TongHop = .Range("A8:A" & i).Resize(, sCol).Value
.Range("A9:A" & i).Resize(, sCol).ClearContents
End With
With Sheets("DMSP")
i = .Range("B8").End(xlDown).Row
Res = .Range("A9:A" & i).Resize(, sCol).Value
End With
With CreateObject("scripting.dictionary")
For i = 2 To UBound(Res) - 1
If Len(Res(i, 4)) > 0 Then 'Chinh so 4
If Len(Res(i - 1, 4)) = 0 Then khStr = Res(i - 1, 2) 'Chinh so 4
.Item(khStr & "#" & Res(i, 5)) = i 'Chinh so 5
End If
Next i
For i = 2 To UBound(TongHop) - 1
If Len(TongHop(i, 4)) > 0 Then 'Chinh so 4
If Len(TongHop(i - 1, 4)) = 0 Then khStr = TongHop(i - 1, 2) 'Chinh so 4
ik = .Item(khStr & "#" & TongHop(i, 5)) 'Chinh so 5
If ik Then
For j = 13 To sCol
If Len(TongHop(i, j)) Then Res(ik, j) = TongHop(i, j)
Next j
End If
End If
Next i
If jCol Then
For i = 1 To UBound(DuLieu) Step 8
ik = .Item(DuLieu(i, 1) & "#" & DuLieu(i, 2))
If ik Then Res(ik, jCol) = DuLieu(i, 49)
Next i
End If
End With
Sheets("TONG_HOP").Range("A9").Resize(UBound(Res), UBound(Res, 2)) = Res
End Sub
Thử chỉnh code trong bài của anh @HieuCD
Dim i As Long, ik As Long, j As Long, sCol As Long, jCol As Long
Dim Ngay As Date
DuLieu = .Range("E6:BA" & i).Value
Ngay = .Range("D2").ValueDim i As Long, ik As Long, j As Long, sCol As Long, jCol As Variant
Dim Ngay as Long
DuLieu = .Range("E6:BA" & i).Value2
Ngay = .Range("D2").Value2On Error Resume Next
jCol = Application.Match(Ngay, .Range("A8").Resize(, sCol).Value, 0)
On Error GoTo 0jCol = Application.Match(Ngay, .Range("A8").Resize(, sCol).Value2, 0)
If TypeName(jCol) = "Error" Then jCol = 0If jCol ThenIf jCol>0 ThenKhông rỏ nhập liệu như thế nào, nên chỉ điều chỉnh khai báo
Không rỏ đặc điểm tạo mã hàng, nên ghép Khách hàng và mã hàng làm key của Dic
Sub GPE_3()
Dim Res(), DuLieuKey(), DuLieuSum(), TongHop()
Dim khStr As String, iKey As String
Dim i As Long, ik As Long, j As Long, sCol As Long, jCol As Long
Dim Ngay As Date
With Sheets("DU_LIEU")
i = .Range("E1000000").End(xlUp).Row
DuLieuKey = .Range("E6:F" & i).Value
DuLieuSum = .Range("BG6:BK" & i).Value
Ngay = .Range("D2").Value
End With
With Sheets("TONG_HOP")
i = .Range("B8").End(xlDown).Row
sCol = .Range("AAA8").End(xlToLeft).Column
On Error Resume Next
jCol = Application.Match(Ngay, .Range("A8").Resize(, sCol).Value, 0)
On Error GoTo 0
TongHop = .Range("A8:A" & i).Resize(, sCol).Value
.Range("A9:A" & i).Resize(, sCol).ClearContents
End With
With Sheets("DMSP")
i = .Range("B8").End(xlDown).Row
Res = .Range("A9:G" & i).Value
ReDim Preserve Res(1 To UBound(Res), 1 To sCol)
End With
With CreateObject("scripting.dictionary")
For i = 2 To UBound(Res) - 1
If Len(Res(i, 5)) > 0 Then
If Len(Res(i - 1, 5)) = 0 Then khStr = Res(i - 1, 2)
.Item(khStr & "#" & Res(i, 5)) = i
End If
Next i
For i = 2 To UBound(TongHop) - 1
If Len(TongHop(i, 5)) > 0 Then
If Len(TongHop(i - 1, 5)) = 0 Then khStr = TongHop(i - 1, 2)
ik = .Item(khStr & "#" & TongHop(i, 5))
If ik > 0 Then
For j = 13 To sCol
If Len(TongHop(i, j)) Then Res(ik, j) = TongHop(i, j)
Next j
End If
End If
Next i
If jCol Then
For i = 1 To UBound(DuLieuKey) Step 8
ik = .Item(DuLieuKey(i, 1) & "#" & DuLieuKey(i, 2))
If ik > 0 Then Res(ik, jCol) = DuLieuSum(i, 1) + DuLieuSum(i, 4) + DuLieuSum(i, 5)
Next i
End If
End With
Sheets("TONG_HOP").Range("A9").Resize(UBound(Res), UBound(Res, 2)) = Res
End Sub@HieuCD
Thêm bẩy lỗi
Sub GPE_3()
Dim Res(), DuLieuKey As Variant, DuLieuSum(), TongHop As Variant
Dim iKey As String
Dim i As Long, ik As Long, j As Long, sCol As Long, jCol As Long
Dim Ngay
With Sheets("TONG_HOP")
sCol = .Range("AAA8").End(xlToLeft).Column
On Error Resume Next
jCol = Application.Match(Ngay, .Range("A8").Resize(, sCol).Value, 0)
On Error GoTo 0
i = .Range("B8").End(xlDown).Row
If i < Rows.Count Then
TongHop = .Range("A8:A" & i).Resize(, sCol).Value
.Range("A9:A" & i).Resize(, sCol).ClearContents
End If
End With
With Sheets("DMSP")
i = .Range("B" & Rows.Count).End(xlUp).Row
If i < 9 Then MsgBox ("Khong co du lieu"): Exit Sub
Res = .Range("A9:G" & i).Value
ReDim Preserve Res(1 To UBound(Res), 1 To sCol)
End With
With Sheets("DU_LIEU")
i = .Range("F1000000").End(xlUp).Row
If i > 5 Then
DuLieuKey = .Range("F6:F" & i).Value
DuLieuSum = .Range("BG6:BK" & i).Value
Ngay = .Range("D2").Value
End If
End With
With CreateObject("scripting.dictionary")
For i = 2 To UBound(Res) - 1
iKey = Res(i, 5)
If Len(iKey) > 0 Then .Item(iKey) = i
Next i
If TypeName(TongHop) = "Variant()" Then
For i = 2 To UBound(TongHop) - 1
iKey = TongHop(i, 5)
If Len(iKey) > 0 Then
ik = .Item(iKey)
If ik > 0 Then
For j = 13 To sCol
If Len(TongHop(i, j)) Then Res(ik, j) = TongHop(i, j)
Next j
End If
End If
Next i
End If
If jCol And TypeName(DuLieuKey) = "Variant()" Then
For i = 1 To UBound(DuLieuKey) Step 8
ik = .Item(DuLieuKey(i, 1))
If ik > 0 Then Res(ik, jCol) = DuLieuSum(i, 1) + DuLieuSum(i, 4) + DuLieuSum(i, 5)
Next i
End If
End With
Sheets("TONG_HOP").Range("A9").Resize(UBound(Res), UBound(Res, 2)) = Res
End Sub
Bạn chạy thử Sub "Cùi Bắp" này xem sao.
Public Sub LuXuBu()
Const Col As Long = 12
Dim Dic As Object, Txt As String
Dim sArr(), tArr(), dArr()
Dim I As Long, J As Long, K As Long, N As Long, R As Long, R2 As Long, Thang As Long
Set Dic = CreateObject("Scripting.Dictionary")
Thang = Month(Sheets("DU_LIEU").Range("D2"))
With Sheets("DMSP")
sArr = .Range("A9", .Range("B9").End(xlDown)).Resize(, 7).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To Thang + Col)
For I = 1 To R
Txt = sArr(I, 5)
If Len(Txt) Then Dic.Item(Txt) = I
For J = 1 To 7
dArr(I, J) = sArr(I, J)
Next J
Next I
End With
With Sheets("DU_LIEU")
sArr = .Range("F6", .Range("F100000").End(xlUp)).Resize(, 58).Value
R2 = UBound(sArr)
For I = 1 To R2 Step 8
Txt = sArr(I, 1)
If Dic.Exists(Txt) Then
N = Dic.Item(Txt)
dArr(N, Thang + Col) = sArr(I, 54) + sArr(I, 57) + sArr(I, 58)
End If
Next I
End With
With Sheets("TONG_HOP")
sArr = .Range("A9", .Range("B9").End(xlDown)).Resize(, Thang + Col - 1).Value
R2 = UBound(sArr)
For I = 2 To R2
Txt = sArr(I, 5)
If Dic.Exists(Txt) Then
N = Dic.Item(Txt)
For J = 1 To Thang - 1
dArr(N, J + Col) = sArr(I, J + Col)
Next J
End If
Next I
.Range("A9").Resize(1000, 24).ClearContents
.Range("A9").Resize(R, Thang + Col) = dArr
End With
Set Dic = Nothing
End SubChỉnh lại
Sub GPE_3()
Dim Res As Variant, DuLieuKey As Variant, DuLieuSum As Variant, TongHop As Variant
Dim iKey As String
Dim i As Long, ik As Long, j As Long, sCol As Long, jCol As Long
Dim Ngay
With Sheets("DU_LIEU")
i = .Range("F1000000").End(xlUp).Row
If i > 5 Then
DuLieuKey = .Range("F6:F" & i).Value
DuLieuSum = .Range("BG6:BK" & i).Value
Ngay = .Range("D2").Value
End If
End With
With Sheets("TONG_HOP")
sCol = .Range("AAA8").End(xlToLeft).Column
On Error Resume Next
jCol = Application.Match(Ngay, .Range("A8").Resize(, sCol).Value, 0)
On Error GoTo 0
i = .Range("B8").End(xlDown).Row
If i < Rows.Count Then
TongHop = .Range("A8:A" & i).Resize(, sCol).Value
.Range("A9:A" & i).Resize(, sCol).ClearContents
End If
End With
With Sheets("DMSP")
i = .Range("B" & Rows.Count).End(xlUp).Row
If i < 9 Then MsgBox ("Khong co du lieu"): Exit Sub
Res = .Range("A9:G" & i).Value
ReDim Preserve Res(1 To UBound(Res), 1 To sCol)
End With
With CreateObject("scripting.dictionary")
For i = 2 To UBound(Res) - 1
iKey = CStr(Res(i, 5))
If Len(iKey) > 0 Then .Item(iKey) = i
Next i
If TypeName(TongHop) = "Variant()" Then
For i = 2 To UBound(TongHop) - 1
iKey = CStr(TongHop(i, 5))
If Len(iKey) > 0 Then
ik = .Item(iKey)
If ik > 0 Then
For j = 13 To sCol
If Len(TongHop(i, j)) Then Res(ik, j) = TongHop(i, j)
Next j
End If
End If
Next i
End If
If jCol And TypeName(DuLieuKey) = "Variant()" Then
For i = 1 To UBound(DuLieuKey) Step 8
ik = .Item(CStr(DuLieuKey(i, 1)))
If ik > 0 Then Res(ik, jCol) = DuLieuSum(i, 1) + DuLieuSum(i, 4) + DuLieuSum(i, 5)
Next i
End If
End With
Sheets("TONG_HOP").Range("A9").Resize(UBound(Res), UBound(Res, 2)) = Res
End Sub
Xin chào Miền Cát Trắng
