Viết lại code tính giá, code trước theo qui trình của bạn là không đúng, và chỉnh tạm vài công thức cho nhẹ file, nhưng vẫn không tính được giá xuất kho của nhiều vật liệu
Hàm Sumifs nặng hơn hàm Sumif nhiều, mình dùng cột phụ để gom các điều kiện vào 1 cột để dùng hàm Sumif cho đơn giản và nhẹ file
Tạo sheet NXT
Sub TaoNXT()
Dim i As Long, j As Byte, k As Long, ik As Long, key As String, Test As Boolean
Dim Dic As Object, Arr As Variant, dArr As Variant, Col As Variant, Tmp As Variant, S As Variant
Set Dic = CreateObject("Scripting.Dictionary")
i = Sheets("XNT").Range("A" & Rows.Count).End(xlUp).Row
If i > 9 Then
dArr = Sheets("XNT").Range("B10:W" & i).Value
ReDim Arr(1 To UBound(dArr, 1), 1 To 18)
Col = Array("", 5, 6, 7, 8, 9, 10, 14, 15, 16)
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
Test = False
For j = 1 To 9
If dArr(i, Col(j)) > 0 Then Test = True: Exit For
Next j
If Test = True Then 'Kiem tra co du lieu moi lay
key = dArr(i, 1)
If Not Dic.exists(key) Then
k = k + 1
Dic.Add key, k
For j = 1 To 3
Arr(k, j) = dArr(i, j)
Next j
Tmp = Split(Arr(k, 1), " ")
S = Split(LCase(Tmp(UBound(Tmp))), "x")
If IsArray(S) Then
For j = 0 To UBound(S)
Arr(k, j + 4) = S(j)
Next j
End If
For j = 1 To 9
Arr(k, j + 6) = dArr(i, Col(j))
Next j
Else
ik = Dic.Item(key)
For j = 1 To 9
Arr(ik, j + 6) = Arr(ik, j + 6) + dArr(i, Col(j))
Next j
End If
End If
End If
Next i
End If
For i = 1 To k
For j = 7 To 9
Arr(i, j + 9) = Arr(i, j) + Arr(i, j + 3) - Arr(i, j + 6)
Next j
Next i
With Sheets("NXT")
Range("A10:R235").ClearContents
Range("A10").Resize(k, 18) = Arr
End With
End SubSheet XNT làm rồi mà, bạn muốn như thế nào?
Dùng công thức chạy vèo vèo là tốt rồi, bạn muốn mình làm gì?
Up đã lâu mà không ai giúp mình vậy ta.
Chạy đoạn code này xem sao
Public Sub ThanhThat()
Dim Wsh As Worksheet
Dim Res
Dim Cll As Range
Dim i
With CreateObject("Scripting.Dictionary")
For Each Wsh In Worksheets
If Wsh.Name <> "Sheet1" Then
For Each Cll In Wsh.UsedRange
If Cll.Value <> "" Then
If .exists(Cll.Value) = False Then
.Add Cll.Value, Array(Cll.Address, Wsh.Name, 1)
Else
Tmp = .Item(Cll.Value)
Tmp(2) = Tmp(2) + 1
.Item(Cll.Value) = Tmp
End If
End If
Next Cll
End If
Next Wsh
For Each i In .keys
If .Item(i)(2) > 1 Then .Remove i
Next i
ReDim Res(1 To .Count, 1 To 3)
For i = 0 To .Count - 1
Res(i + 1, 1) = .items()(i)(1)
Res(i + 1, 2) = .items()(i)(0)
Res(i + 1, 3) = .keys()(i)
Next i
End With
With Sheet1
.Range("A2", .Range("C" & .Range("A2").End(xlDown).Row)).ClearContents
.Range("A2").Resize(UBound(Res), UBound(Res, 2)) = Res
End With
End Sub.Remove Cll.Value chỗ này chắc đúng không bạn?
Dán code lên mới nhận ra, sửa lại bài trên rồi bạn
Để mình kiểm tra xem đã nhé, Cám ơn Bạn nhiều !
Bạn giúp lại mình với ! Code chỉ tìm trên một cột bất kỳ của các sheet nhập vào từ bàn phím.
Các AC chỉnh sữa giúp với !!!
Gởi file thật với dữ liệu giả định lên
