Hình như bạn muốn tạo một nút CommandButton, bấm vào để lấy dữ liệu thì phải?
Bài này có nhiều cách giải
Public Sub Sang()
Dim Vung As Range, Mg(), Ws As Worksheet, DlLay As Range, iHang As Long, Cll As Range, kK As Long
Set Ws = Sheets("DS2")
Set DlLay = Ws.Range(Ws.[d4], Ws.[d10000].End(xlUp))
Set Vung = Range([d4], [d10000].End(xlUp))
'Khai báo các bien
ReDim Mg(1 To Vung.Rows.Count, 1 To 3)
'Khai báo mang 2 chieu Mg có so hàng = so hàng cua bien Vung, so côt = 3
kK = 1
'Gán gia tri cho bien kK
For Each Cll In Vung
'Cho bien Cll chay trong Vung
On Error Resume Next
'Nêu xay ra loi thì nhay xuong làm công viec kê tiep
iHang = Application.WorksheetFunction.Match(Cll, DlLay, 0)
'Tìm gia tri cua bien iHang
If iHang > 0 Then
'neu iHang >0 thì gán gia tri tuong ung o sheet DS2 vào mang
Mg(kK, 1) = DlLay(iHang).Offset(, 3)
Mg(kK, 2) = DlLay(iHang).Offset(, 4)
Mg(kK, 3) = DlLay(iHang).Offset(, 5)
Else
'Nguoc lai, gán vào mang gia tri trong
Mg(kK, 1) = ""
Mg(kK, 2) = ""
Mg(kK, 3) = ""
End If
iHang = 0
kK = kK + 1
'Gán lai gia tri cua bien iHang & kK
Next
'thoat vong lap
[g4].Resize(Vung.Rows.Count, 3) = Mg
'Gán gia tri cua mang vao vùng muon nhan ket qua o sheet DS1
End Sub
Đã dùng mảng thì anh nên dùng cho trọn luôn! Thay vì dùng hàm MATCH, anh nên cho 1 vòng lập For đầu tiên đi "thu thập" các loại MÃ có trong DS1 rồi nạp vào Dictionary... Tiếp theo dùng vòng lập For thứ 2 quét qua các MÃ ở DS2, tra các mã này vào Dictionary và... ra quyết định gì đó
Private Sub CommandButton1_Click()
Dim Rg1 As Range, Rg2 As Range, Cl As Range
Dim Fc As WorksheetFunction
Set Fc = WorksheetFunction
Set Rg1 = Sheet1.[D4].Resize(Fc.CountA(Sheet1.[D4:D65536]))
Set Rg2 = Sheet2.[D4].Resize(Fc.CountA(Sheet2.[D4:D65536]))
Rg1.Offset(, 3).Resize(, 3).ClearContents
For Each Cl In Rg1
If Fc.CountIf(Rg2, Cl) > 0 Then Cl.Offset(, 3).Resize(, 3).Value _
= Rg2(Fc.Match(Cl, Rg2, 0)).Offset(, 3).Resize(, 3).Value
Next
Set Rg1 = Nothing: Set Rg2 = Nothing: Set Cl = Nothing : Set Fc=Nothing
End SubNếu dữ liệu nhiều bạn thử code này xem sao
Public Sub Chuyen()
Dim Ws As Worksheet, d As Object, mChuyen, I As Long, kK As Long, mNhan, Mg(), iHang As Long, J As Long, Chuyen1, Chuyen2, Chuyen3, mM As Long
Set d = CreateObject("scripting.dictionary")
Set Ws = Sheets("DS2")
iHang = Range([d4], [d10000].End(xlUp)).Rows.Count
ReDim Mg(1 To iHang, 1 To 3)
mNhan = Range([d4], [d10000].End(xlUp)).Value
mChuyen = Ws.Range(Ws.[d4], Ws.[d1000].End(xlUp)).Value
Chuyen1 = Ws.Range(Ws.[g4], Ws.[g10000].End(xlUp)).Value
Chuyen2 = Ws.Range(Ws.[h4], Ws.[h10000].End(xlUp)).Value
Chuyen3 = Ws.Range(Ws.[i4], Ws.[i10000].End(xlUp)).Value
kK = 1
For I = 1 To UBound(mChuyen)
If Not d.exists(mChuyen(I, 1)) Then
d.Add mChuyen(I, 1), kK
kK = kK + 1
End If
Next I
For J = 1 To UBound(mNhan)
If d.exists(mNhan(J, 1)) Then
mM = d.Item(mNhan(J, 1))
Mg(J, 1) = Chuyen1(mM, 1): Mg(J, 2) = Chuyen2(mM, 1): Mg(J, 3) = Chuyen3(mM, 1)
End If
Next J
[g4].Resize(iHang, 3) = Mg
End SubĐể đơn giản hóa vấn đề thì tôi nghĩ bạn nên nghiên cứu Advanced Filter, vì nó có thể giải quyết được yêu cầu của bạn đấy
Sub FindAndMatch()
Dim Src1 As Range, Src2 As Range
Set Src1 = Sheets("DS1").Range("C3").CurrentRegion
Set Src2 = Sheets("DS2").Range("C3").CurrentRegion
With Src1
.AdvancedFilter 1, .Parent.Range("A1:A2")
.Offset(1).SpecialCells(12).ClearContents
.Parent.ShowAllData
.Sort .Cells(1, 1), 1, , , , , , 1
End With
With Src1.CurrentRegion
.Offset(.Rows.Count).Resize(Src2.Rows.Count).Value = Src2.Offset(1).Value
End With
With Src1.CurrentRegion
.Sort .Cells(1, 1), 1, , , , , , 1
End With
End Sub
