Private Sub ComboBox2_GotFocus()
On Error Resume Next
If Not IsArray(ComboBox2.List) Then Call CreaTon
ComboBox2.DropDown
End Sub
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
Call LocTon
Range("F1").Select
End If
End Sub
Sub CreaTon()
Dim Darr(), Arr(), i As Long, k As Long, d As Long, R As Long, Tmp As String
With CreateObject("Scripting.Dictionary")
Darr = Range("F2", Range("F2").End(xlDown)).Value
For i = 1 To UBound(Darr)
Tmp = Darr(i, 1)
If Not .Exists(Tmp) Then .Add Tmp, ""
Next i
ComboBox2.List = .keys
End With
End Sub
Private Sub LocTon()
Dim Rng As Range, LastR As Long, Dk As String, i As Long
Dk = ComboBox2.Value
Range("F2:F" & 10000).EntireRow.Hidden = False
LastR = Range("B2").End(xlDown).Row
If Dk = "" Then Exit Sub
For i = 2 To LastR
If Range("F" & i).Value <> Dk Then
If Rng Is Nothing Then
Set Rng = Range("F" & i)
Else
Set Rng = Union(Rng, Range("F" & i))
End If
End If
Next i
If Not Rng Is Nothing Then Rng.EntireRow.Hidden = True
End Sub
Sub Ton()
Dim Narr(), Xarr(), Arr(), DH(), i As Long, k As Long, d As Long, R As Long, Tmp As String
With CreateObject("Scripting.Dictionary")
With Sheets("Nhap")
Narr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 4).Value
End With
With Sheets("Xuat")
Xarr = .Range("D2", .Range("D2").End(xlDown)).Resize(, 4).Value
End With
ReDim Arr(1 To UBound(Narr) + UBound(Xarr), 1 To 6)
For i = 1 To UBound(Narr)
Tmp = Narr(i, 1) & "#" & Narr(i, 2) & "#" & Narr(i, 4)
If Not .Exists(Tmp) Then
k = k + 1: .Add Tmp, k
Arr(k, 1) = Narr(i, 1): Arr(k, 2) = Narr(i, 2)
Arr(k, 3) = Narr(i, 3): Arr(k, 5) = Narr(i, 3)
Arr(k, 6) = Narr(i, 4)
Tmp = Narr(i, 4)
If Not .Exists(Tmp) Then .Add Tmp, "": ReDim Preserve DH(d): DH(d) = Tmp: d = d + 1:
Else
R = .Item(Tmp)
Arr(R, 3) = Arr(R, 3) + Narr(i, 3)
Arr(R, 5) = Arr(R, 3)
End If
Next i
For i = 1 To UBound(Xarr)
Tmp = Xarr(i, 1) & "#" & Xarr(i, 2) & "#" & Xarr(i, 4)
If Not .Exists(Tmp) Then
k = k + 1: .Add Tmp, k
Arr(k, 1) = Xarr(i, 1): Arr(k, 2) = Xarr(i, 2)
Arr(k, 4) = Xarr(i, 3): Arr(k, 5) = Arr(k, 5) - Xarr(i, 3)
Arr(k, 6) = Xarr(i, 4)
Else
R = .Item(Tmp)
Arr(R, 4) = Arr(R, 4) + Xarr(i, 3)
Arr(R, 5) = Arr(R, 5) - Xarr(i, 3)
End If
Next i
End With
With Sheets("Ton")
.Range("A2:F10000").ClearContents
.Range("A2").Resize(k, 6) = Arr
.Range("A2").Resize(k, 6).Borders.LineStyle = 1
.Range("C2").Resize(k, 3).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
.ComboBox2.List = DH
End With
End Sub
