Chỉnh code VBA bị sai (7 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Status
Không mở trả lời sau này.

d.dinhtam

Thành viên mới
Tham gia
21/4/18
Bài viết
16
Được thích
0
Giới tính
Nam
Nhờ a/c xem dùm đoạn code bị sai ở đâu mà dữ liệu ko gắn vào sheet11 đầy đủ.
Sub rep()
Dim i As Long, j As Long, K As Long
Dim K1 As Long
Dim ArrNguon()
Dim ArrDich()
Dim Arr_MH()
Dim Dongcuoi As Long
Dim Dic_MH As Object

Dongcuoi = Sheet10.Range("e60000").End(xlUp).Row
ArrNguon = Sheet10.Range("a6:m" & Dongcuoi)
ReDim Arr_MH(1 To UBound(ArrNguon, 1), 1 To 5)
ReDim Arr_Ngay(1 To 1, 1 To UBound(ArrNguon, 1))

Sheet11.Range("a10:d60000").ClearContents

Set Dic_MH = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(ArrNguon, 1)
If Trim(ArrNguon(i, 5)) <> "" Then 'Trim loc bo khoang trong, cot 5 Ma'
If Not Dic_MH.Exists(ArrNguon(i, 5)) Then
K = K + 1
Dic_MH.Add ArrNguon(i, 5), K
Arr_MH(K, 1) = K
Arr_MH(K, 2) = ArrNguon(i, 1)
Arr_MH(K, 3) = ArrNguon(i, 3)
Arr_MH(K, 4) = ArrNguon(i, 4)
Arr_MH(K, 5) = ArrNguon(i, 5)

End If
End If
Next
Sheet11.Range("B9").Resize(K, 3).NumberFormat = "@"
Sheet11.Range("A9").Resize(K, 4) = Arr_MH

End Sub
 

File đính kèm

Nhờ a/c xem dùm đoạn code bị sai ở đâu mà dữ liệu ko gắn vào sheet11 đầy đủ.
Sub rep()
Dim i As Long, j As Long, K As Long
Dim K1 As Long
Dim ArrNguon()
Dim ArrDich()
Dim Arr_MH()
Dim Dongcuoi As Long
Dim Dic_MH As Object

Dongcuoi = Sheet10.Range("e60000").End(xlUp).Row
ArrNguon = Sheet10.Range("a6:m" & Dongcuoi)
ReDim Arr_MH(1 To UBound(ArrNguon, 1), 1 To 5)
ReDim Arr_Ngay(1 To 1, 1 To UBound(ArrNguon, 1))

Sheet11.Range("a10:d60000").ClearContents

Set Dic_MH = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(ArrNguon, 1)
If Trim(ArrNguon(i, 5)) <> "" Then 'Trim loc bo khoang trong, cot 5 Ma'
If Not Dic_MH.Exists(ArrNguon(i, 5)) Then
K = K + 1
Dic_MH.Add ArrNguon(i, 5), K
Arr_MH(K, 1) = K
Arr_MH(K, 2) = ArrNguon(i, 1)
Arr_MH(K, 3) = ArrNguon(i, 3)
Arr_MH(K, 4) = ArrNguon(i, 4)
Arr_MH(K, 5) = ArrNguon(i, 5)

End If
End If
Next
Sheet11.Range("B9").Resize(K, 3).NumberFormat = "@"
Sheet11.Range("A9").Resize(K, 4) = Arr_MH

End Sub
Cột Loại vàng chỉ có 1 loại là 18K.
Bạn sử dụng Scripting.Dictionary để kiểm tra loại vàng --> chỉ có dữ liệu ở dòng đầu tiên thỏa mãn
Kết quả bạn nhận được như vậy là đúng rồi.
1 lưu ý khác:
Mã:
ReDim Arr_MH(1 To UBound(ArrNguon, 1), 1 To 5)
Ở đoạn cuối:
Mã:
Sheet11.Range("A9").Resize(K, 4) = Arr_MH
Dữ liệu chuyển sang Sheet11 sẽ bị thiếu 1 cột
 
Upvote 0
Cột Loại vàng chỉ có 1 loại là 18K.
Bạn sử dụng Scripting.Dictionary để kiểm tra loại vàng --> chỉ có dữ liệu ở dòng đầu tiên thỏa mãn
Kết quả bạn nhận được như vậy là đúng rồi.
1 lưu ý khác:
Mã:
ReDim Arr_MH(1 To UBound(ArrNguon, 1), 1 To 5)
Ở đoạn cuối:
Mã:
Sheet11.Range("A9").Resize(K, 4) = Arr_MH
Dữ liệu chuyển sang Sheet11 sẽ bị thiếu 1 cột
Bạn giúp minh sửa lại doan code cho dung duoc ko. giup mình với mình mới học lám nên ko ranh lắm
 
Upvote 0
Upvote 0
Upvote 0
Bạn nói rõ là bạn muốn chuyển dữ liệu như thế nào, điều kiện chuyển ra sao?
Gửi bạn, trong file mẩu của mình có 2sheet : "NKGN" và "BCTK" mình muốn lấy dữ liệu cột : mã bao,mã hàng, loại vàng từ sheet "NKGN" sang sheet "BCTK" và điều kiện lọc là cột A của sheet "NKGN" những mã trùng lặp thì lấy 1 lần.
 

File đính kèm

Upvote 0
Gửi bạn, trong file mẩu của mình có 2sheet : "NKGN" và "BCTK" mình muốn lấy dữ liệu cột : mã bao,mã hàng, loại vàng từ sheet "NKGN" sang sheet "BCTK" và điều kiện lọc là cột A của sheet "NKGN" những mã trùng lặp thì lấy 1 lần.
Điều kiện lọc là cột A thì thay cái
If Not Dic_MH.Exists(ArrNguon(i, 4)) Then thành If Not Dic_MH.Exists(ArrNguon(i, 1)) Then

Dic_MH.Add ArrNguon(i, 4), K thành Dic_MH.Add ArrNguon(i, 1), K
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

Bài viết mới nhất

Back
Top Bottom