Em nhờ các Anh, Thầy viết code chuyển dữ liệu từ Sheet này sang Sheet khác ạ
- Thread starter babe_nice
- Ngày gửi
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,975
- Được thích
- 9,860
- Nghề nghiệp
- Công chức
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).
Upvote
0
babe_nice
Thành viên chính thức
- Tham gia
- 30/8/09
- Bài viết
- 89
- Được thích
- 9
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 )
Upvote
0
babe_nice
Thành viên chính thức
- Tham gia
- 30/8/09
- Bài viết
- 89
- Được thích
- 9
Mã:
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
Lần chỉnh sửa cuối:
Upvote
0
sealand
Thành viên gạo cội
- Tham gia
- 16/5/08
- Bài viết
- 4,884
- Được thích
- 7,687
- Giới tính
- Nam
- Nghề nghiệp
- Kế Toá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ử:
+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
Upvote
0
babe_nice
Thành viên chính thức
- Tham gia
- 30/8/09
- Bài viết
- 89
- Được thích
- 9
Em cám ơn Thầy ạ, em mày mò..." lộn ngược - xuôi" này cũng hết rồi ạ...
Em ngại nhất: giải ý 1 xong, lại nghĩ ra câu hỏi cho ý 2, rồi sửa chả được, lại nhờ....nhờ nhiều..chỉ sợ Thầy ( và diễn đàn ) lại thấy em lười không nghĩ...Dù sao cũng xong, vui quá trời luôn.
Upvote
0
babe_nice
Thành viên chính thức
- Tham gia
- 30/8/09
- Bài viết
- 89
- Được thích
- 9
Em cám ơn anh Sealand nhiều.
Em test luôn, cứ nhìn thấy code, là si mê luôn, có điều đúng là
Collection lạ quá,...??
Code vẫn chạy, nhưng ra kết quả em cộng lại không đúng ạ.
( anh cứ để em nghĩ xem là tại sao...ẹc, nhưng đây không phải Dic,..thôi cứ để em nghĩ tý )
Upvote
0
babe_nice
Thành viên chính thức
- Tham gia
- 30/8/09
- Bài viết
- 89
- Được thích
- 9
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
Mã:
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
Lần chỉnh sửa cuối:
Upvote
0
sealand
Thành viên gạo cội
- Tham gia
- 16/5/08
- Bài viết
- 4,884
- Được thích
- 7,687
- Giới tính
- Nam
- Nghề nghiệp
- Kế Toán
Mình lấy luôn cái vùng dữ liệu mà bạn đã xác định vì nó không phải là mục đích thắc mắc của bạn. Nhưng nay thấy bạn sửa vậy mình cho rằng vẫn chưa ổn. Thực tế có thể nhiều hơn chủng loại SP và NVL nên cái vùng dữ liệu có thể "động" cả 2 chiều. Vậy code nên sửa thế này ổn hơn
Mã:
Tm = Sheet6.Range(Sheet6.[C65000].End(xlUp), Sheet6.Cells(8, Sheet6.Columns.Count).End(xlToLeft)).Value
Upvote
0
Bài viết mới nhất
- Question
- Question
