Em xin nhờ các anh và Thầy giúp đỡ.
Code vận dụng Dic để chuyển dữ liệu từ Sheet DULIEU sang Sheet Chuyen1 và Chuyen2 ạ.
Em cám ơn nhiều ạ.
Vâng, em nói rõ hơn:Bạn đính kèm File nhưng việc đặt vấn đề chưa rõ, vì cột C (Ma TP) sheet DULIEU có nhiều loại mã, nhưng bạn chỉ nêu có 2 sheet CHUYEN1 và CHUYEN2 là sao chẳng ai hiểu nổi (hay là mỗi Ma TP xuất ra 1 sheet).
Vâng, em nói rõ hơn:
- trong Sheet DULIEU có Cột là Ma TP tức là Mã Thành Phẩm
- Còn dãy từ D8 là dãy NVL tức là NVL
Bây giờ, em muốn lấy sang Sheet Chuyen1 là: Cột Mã NVL, còn hàng là Mã TP
Còn Sheet Chuyen 2 là Cột là Mã TP, hàng là Mã NVL.
( dữ liệu cho trước là Cột có mã trùng, và hàng cũng có mã trùng )
Giải thích thì phải từ đầu, những người không theo dõi "bên kia" làm sao hiểu được "bên nầy".
Code cho sheet CHUYEN1. Cái còn lại tự "ngâm" thêm, chừng nào không được hãy "la làng" tiếp.
Public Sub GPE_Chuyen2()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, MaxCol As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DULIEU")
sArr = .Range(.[A8], .[A8].End(xlDown)).Resize(, .[A8].End(xlToRight).Column).Value
ReDim dArr(1 To UBound(sArr, 2) + 1, 1 To UBound(sArr, 1) + 3)
dArr(1, 1) = "STT": dArr(1, 2) = sArr(1, 2): dArr(1, 3) = .Range("C7").Value
End With
'K = 1
For I = 2 To UBound(sArr, 1) '<----------------Chay cot
If Not Dic.Exists(sArr(I, 3)) Then
K = K + 1
Dic.Add sArr(I, 3), K
dArr(K, 1) = K
dArr(K, 2) = "Kg" '<----------------dzo dzieng that'
dArr(K, 3) = sArr(I, 3)
End If
Next I
MaxCol = 3
For J = 4 To UBound(sArr, 2) '<----------------Chay hang
If Not Dic.Exists(sArr(1, J)) Then
MaxCol = MaxCol + 1
Dic.Add sArr(1, J), MaxCol
dArr(1, MaxCol) = sArr(1, J)
' End If
Else 'For J = 4 To UBound(sArr, 2)
Col = Dic.Item(sArr(1, J))
Rws = Dic.Item(sArr(I, 3))
If sArr(I, J) > 0 Then
dArr(Rws, Col) = dArr(Rws, Col) + sArr(I, J)
End If
End If
Next J
'Next I
With Sheets("CHUYEN2")
.[A8].Resize(K, MaxCol) = dArr
End With
End Sub
Thưa Thầy, em chỉnh code, hiểu tạm nguyên lý : không đảo cột - hàng nữa, chỉ việc cộng gộp hàng và cột khi trùng nhau nữa thôi,.... thế mà vẫn không chạy được ạ...em nhờ Thầy sửa ạ.
Sub Reset_Chuyen1()
Dim Kq(), Tm, SP As New Collection, NVL As New Collection, eR, eC, i, j
Tm = Sheet6.Range(Sheet6.[C8], Sheet6.[C8].End(xlDown)).Resize(, 33).Value
ReDim Kq(1 To UBound(Tm, 2), 1 To UBound(Tm, 1))
Kq(1, 1) = "STT": Kq(1, 2) = "DVT": Kq(1, 3) = "MA TP"
On Error Resume Next
For i = 2 To UBound(Tm, 1)
SP.Add SP.Count + 1, Tm(i, 1)
eC = SP.Item(Tm(i, 1))
Kq(1, eC + 3) = Tm(i, 1)
For j = 2 To UBound(Tm, 2)
NVL.Add NVL.Count + 1, Tm(1, j)
eR = NVL.Item(Tm(1, j))
Kq(eR + 1, 1) = eR
Kq(eR + 1, 2) = WorksheetFunction.VLookup(Tm(i, 1), Sheet1.[A5:B1000], 2, 0)
Kq(eR + 1, 3) = Tm(1, j)
Kq(eR + 1, eC + 3) = Kq(eR + 1, eC + 3) + Tm(i, j)
Next
Next
Sheet2.[A8].Resize(1000, 1000).ClearContents
Sheet2.[A8].Resize(NVL.Count + 1, SP.Count + 3) = Kq
End Sub
Em cám ơn Thầy ạ, em mày mò..." lộn ngược - xuôi" này cũng hết rồi ạ...Lần này nữa chắc là đủ, hết chuyện "lộn ngược - lộn xuôi" rồi nhé.
Mình tham gia với bạn 1 đoạn code cho CHUYEN 1 có 1 thay đổi dùng Collection thay Dictionary như sau:
+Lý do: Vốn dĩ Dic và Col là 2 tiện ích có chức năng như nhau. Mỗi cái có 1 thế mạnh riêng tùy cơ mà dùng.
-Dic mạnh hơn do có hỗ trợ phương thức Exists và gán Keys hay Items vào mảng v.v... Hạn chế của nó là con nuôi nên mỗi khi dùng phải tạo lập từ thư viện (CreateObject là 1 cách tạo lập), khi thôi phải tống tiễn nó. Và vì vậy nó cũng sẽ bị hạn chế hơn chút ít về tốc độ và tài nguyên nhớ.
-Col vốn là con đẻ (Tích hợp sẵn trong VBA) bạn thấy mình khai báo và sử dụng nó như 1 biến đối tượng của VBA khác , gọi là có liền nhưng hạn chế hơn về chức năng nâng cao. Ở đây ta chỉ cần tạo danh sách duy nhất và tra Item của nó thì Col quá đủ rồi.
+Code như sau bạn Test thử:
Mã:Sub Reset_Chuyen1() Dim Kq(), Tm, SP As New Collection, NVL As New Collection, eR, eC, i, j Tm = Sheet6.Range(Sheet6.[C8], Sheet6.[C8].End(xlDown)).Resize(, 33).Value ReDim Kq(1 To UBound(Tm, 2), 1 To UBound(Tm, 1)) Kq(1, 1) = "STT": Kq(1, 2) = "DVT": Kq(1, 3) = "MA TP" On Error Resume Next For i = 2 To UBound(Tm, 1) SP.Add SP.Count + 1, Tm(i, 1) eC = SP.Item(Tm(i, 1)) Kq(1, eC + 3) = Tm(i, 1) For j = 2 To UBound(Tm, 2) NVL.Add NVL.Count + 1, Tm(1, j) eR = NVL.Item(Tm(1, j)) Kq(eR + 1, 1) = eR Kq(eR + 1, 2) = WorksheetFunction.VLookup(Tm(i, 1), Sheet1.[A5:B1000], 2, 0) Kq(eR + 1, 3) = Tm(1, j) Kq(eR + 1, eC + 3) = Kq(eR + 1, eC + 3) + Tm(i, j) Next Next Sheet2.[A8].Resize(1000, 1000).ClearContents Sheet2.[A8].Resize(NVL.Count + 1, SP.Count + 3) = Kq End Sub
em nhìn ra rồi, đoạn code của anh sửa chỗ này, kết quả đúng luôn :Mình tham gia với bạn 1 đoạn code cho CHUYEN 1 có 1 thay đổi dùng Collection thay Dictionary như sau:
+Lý do: Vốn dĩ Dic và Col là 2 tiện ích có chức năng như nhau. Mỗi cái có 1 thế mạnh riêng tùy cơ mà dùng.
-Dic mạnh hơn do có hỗ trợ phương thức Exists và gán Keys hay Items vào mảng v.v... Hạn chế của nó là con nuôi nên mỗi khi dùng phải tạo lập từ thư viện (CreateObject là 1 cách tạo lập), khi thôi phải tống tiễn nó. Và vì vậy nó cũng sẽ bị hạn chế hơn chút ít về tốc độ và tài nguyên nhớ.
-Col vốn là con đẻ (Tích hợp sẵn trong VBA) bạn thấy mình khai báo và sử dụng nó như 1 biến đối tượng của VBA khác , gọi là có liền nhưng hạn chế hơn về chức năng nâng cao. Ở đây ta chỉ cần tạo danh sách duy nhất và tra Item của nó thì Col quá đủ rồi.
+Code như sau bạn Test thử:
Mã:Sub Reset_Chuyen1() Dim Kq(), Tm, SP As New Collection, NVL As New Collection, eR, eC, i, j Tm = Sheet6.Range(Sheet6.[C8], Sheet6.[C8].End(xlDown)).Resize(, 33).Value ReDim Kq(1 To UBound(Tm, 2), 1 To UBound(Tm, 1)) Kq(1, 1) = "STT": Kq(1, 2) = "DVT": Kq(1, 3) = "MA TP" On Error Resume Next For i = 2 To UBound(Tm, 1) SP.Add SP.Count + 1, Tm(i, 1) eC = SP.Item(Tm(i, 1)) Kq(1, eC + 3) = Tm(i, 1) For j = 2 To UBound(Tm, 2) NVL.Add NVL.Count + 1, Tm(1, j) eR = NVL.Item(Tm(1, j)) Kq(eR + 1, 1) = eR Kq(eR + 1, 2) = WorksheetFunction.VLookup(Tm(i, 1), Sheet1.[A5:B1000], 2, 0) Kq(eR + 1, 3) = Tm(1, j) Kq(eR + 1, eC + 3) = Kq(eR + 1, eC + 3) + Tm(i, j) Next Next Sheet2.[A8].Resize(1000, 1000).ClearContents Sheet2.[A8].Resize(NVL.Count + 1, SP.Count + 3) = Kq End Sub
Tm = Sheet6.Range(Sheet6.[C8], Sheet6.[C8].End(xlDown)).Resize(, 3[COLOR=#ff0000][B]3[/B][/COLOR]).Value
thành
Tm = Sheet6.Range(Sheet6.[C8], Sheet6.[C8].End(xlDown)).Resize(, 3[COLOR=#ff0000][B]5[/B][/COLOR]).Value
Kq(eR + 1, 2) = WorksheetFunction.VLookup(Tm(i, 1), Sheet1.[A5:B1000], 2, 0) '- không quan trọng, em có thể gán kg vào luôn
em nhìn ra rồi, đoạn code của anh sửa chỗ này, kết quả đúng luôn :
Mã:Tm = Sheet6.Range(Sheet6.[C8], Sheet6.[C8].End(xlDown)).Resize(, 3[COLOR=#ff0000][B]3[/B][/COLOR]).Value thành Tm = Sheet6.Range(Sheet6.[C8], Sheet6.[C8].End(xlDown)).Resize(, 3[COLOR=#ff0000][B]5[/B][/COLOR]).Value
Tm = Sheet6.Range(Sheet6.[C65000].End(xlUp), Sheet6.Cells(8, Sheet6.Columns.Count).End(xlToLeft)).Value
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2