Mình vừa phát hiện ra 1 vấn đề trong file là bên Sheet Bảng Tổng Hợp, chỗ col Đơn giá, khi mình đánh giá vào, và nhấn Button Tổng Hợp thì đơn giá mình vừa đánh mất tiêu @@, mọi người giúp mình sửa cái này không thì tiêu mất
Chép đoạn code này paste lại xem sao
[GPECODE=vb]
Public Sub LOC_BTH()
Application.ScreenUpdating = False
Dim Dic As Object, DSKH(), sArr(), dArr(), N As Long, i As Long, j As Long, k As Long
Dim Tem As String, STT As Long, TCong As String, Tong(1 To 1, 1 To 6), Cll As Range, tam
Set Dic = CreateObject("Scripting.Dictionary")
TCong = Sheets("CHITIET_KH").[O5].Value
With Sheets("TEN KH")
DSKH = .Range(.[B6], .[B6].End(xlDown)).Value
End With
With Sheets("NHAP DU LIEU")
sArr = .Range(.[B6], .[B6].End(xlDown)).Resize(, 13).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 10)
For N = 1 To UBound(DSKH, 1)
STT = 0
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) = DSKH(N, 1) Then
Tem = sArr(i, 1) & sArr(i, 2) & sArr(i, 3)
If Not Dic.Exists(Tem) Then
k = k + 1: STT = STT + 1
Dic.Add Tem, k
dArr(k, 1) = STT
For j = 1 To 3
dArr(k, j + 1) = sArr(i, j)
Next j
dArr(k, 5) = 1
dArr(k, 6) = sArr(i, 13)
dArr(k, 7) = 5 / 100
dArr(k, 8) = "=RC[-2] * 95%"
dArr(k, 10) = "=RC[-2]*RC[-1]"
Else
dArr(Dic.Item(Tem), 5) = dArr(Dic.Item(Tem), 5) + 1
dArr(Dic.Item(Tem), 6) = dArr(Dic.Item(Tem), 6) + sArr(i, 13)
End If
End If
Next i
If STT > 0 Then
k = k + 1
dArr(k, 3) = TCong
dArr(k, 5) = "=sum(R[-" & STT & "]C:R[-1]C)"
dArr(k, 6) = "=sum(R[-" & STT & "]C:R[-1]C)"
dArr(k, 8) = "=sum(R[-" & STT & "]C:R[-1]C)"
dArr(k, 10) = "=sum(R[-" & STT & "]C:R[-1]C)"
End If
Next N
With Sheets("BANG TONG HOP")
tam = .Range("I5:I1000").Value 'thêm đoạn này
.[A5:J10000].ClearContents
.[A5:J10000].Borders.LineStyle = xlNone
.[A5:J10000].Interior.ColorIndex = 0
If k Then
.[A5].Resize(k, 10).Value = dArr
.Range("I5:I1000").Value = tam 'thêm đoạn này
.[A5].Resize(k, 10).Borders.LineStyle = xlContinuous
For Each Cll In .Range(.[C5], .[C5].End(xlDown))
If Cll.Value = TCong Then
Cll.Offset(, -2).Resize(, 10).Interior.ColorIndex = 36
End If
Next
End If
End With
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub
[/GPECODE]
Chỗ chú thích là thêm vào theo yêu cầu của bạn
mình ko thể attach file lên được mặc dù đã zip lại rồi, bị thông báo vượt quá dung lượng mình có thể upload, nên bạn vào mega down giùm mình nhé, cám ơn nhiều lắm luôn
