Thử với Find xem, tôi không ngồi máy tính, tuy nhiên bạn thử áp dụng kiểu thế này nhé. Trong trường hợp này, tôi tìm từ "Nghia" trong cột B.
Sub Macro1()
Dim rngFind As Range
Set rngFind = Range("B1:B100").Find(What:="Nghia", LookIn:=xlValues, LookAt:=xlWhole)
If rngFind Is Nothing Then
MsgBox "Nhap thong tin moi vao csdl"
Else
MsgBox "Da ton tai"
End If
End Sub
With Sheet1
lr2 = .Range("F65000").End(xlUp).Row
arr = .Range("D2:D" & lr).Value '?? '
End With
With Sheet10
lr = .Range("F65000").End(xlUp).Row
arr = .Range("A3:Q" & lr).Value '??? '
For d = 1 To lr
For t = 1 To lr2
If arr(d, 4) = arr(t, 4) Then GoTo 1
Else 'Dòng Này Dang Báo Lôi '
Next d
Next t
End If
' . . . . . 'À chỗ này ý đồ của em là so sánh bán hàng của sheet10 với sheet1. Nếu số bán hàng đó sheet1 có rồi thì thôi còn nếu chưa có thì chạy tới Goto1 nhưng đoạn này em bị bí nên lên hỏi mọi người ạ, bác giúp em với
Dạ có ạ, em đang bị lỗi chỗ đấy ạ
để em nghiên cứu lại rồi có gì bác giúp em với nhé, đoạn này em bí quá không biết viết thế nào chứ không phải là viết hàn lâm đâu ạ.
Tự viết thêm lệnh gán mảng kết quả
Sub Loc_Hang_Hoa()
Dim lr As Long, lr2 As Long, arr As Variant, kq(), k As Long
Dim Dic As Object, i As Long, d As Long, t As Long, arr2 As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
lr2 = .Range("D65000").End(xlUp).Row
arr = .Range("D2:D" & lr2).Value
End With
For i = 1 To UBound(arr)
Dic.Item(arr(i, 1)) = ""
Next i
With Sheet10
lr = .Range("D65000").End(xlUp).Row
arr = .Range("A3:Q" & lr).Value
End With
ReDim kq(1 To UBound(arr), 1 To 12)
For i = 1 To UBound(arr)
If Not Dic.exists(arr(i, 4)) Then
k = k + 1
'........
End If
Next i
With Sheet1
If k Then .Range("A" & lr2 + 1).Resize(k, 12).Value = kq
End With
Set Dic = Nothing
End SubBác ơi, sheet đích của em có cả dữ liệu tự gõ vào nữa bác ạ chứ không phải chỉ có lấy mình bên sheet data kia. Bác ơi giờ có cách nào so sánh 2 sheet với nhau để tìm ra một mảng chứa dữ liệu không trùng sau đó mới add vào dic để trả kết quả không, bác giúp em với ạ.
Đã loại dữ liệu trùng sheet đích rồi
Chỉnh lại code
Sub Loc_Hang_Hoa_test()
Dim lr As Long, lr2 As Long, arr As Variant, kq(), k As Long
Dim Dic As Object, i As Long, d As Long, t As Long, arr2 As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
lr2 = .Range("D65000").End(xlUp).Row
arr = .Range("D1:E" & lr2).Value '"D1:E": Lay dòng tieu de
End With
For i = 2 To UBound(arr) 'i=2: Loai dong tieu de
If arr(i, 1) <> Empty Then Dic.Item(arr(i, 1)) = "" 'Loai dòng trong
Next i
With Sheet10
lr = .Range("D65000").End(xlUp).Row
arr = .Range("A3:Q" & lr).Value
End With
ReDim kq(1 To UBound(arr), 1 To 12)
For i = 1 To UBound(arr)
If Not Dic.exists(arr(i, 4)) Then
k = k + 1
kq(k, 1) = arr(i, 1)
kq(k, 2) = arr(i, 3)
kq(k, 4) = arr(i, 4)
kq(k, 5) = arr(i, 5)
kq(k, 6) = arr(i, 6)
If Left(arr(i, 4), 2) = "BH" Then
kq(k, 10) = arr(i, 14)
kq(k, 12) = arr(i, 12)
Else
kq(k, 9) = arr(i, 17)
End If
End If
Next i
With Sheet1
If k Then
.Range("A" & lr2 + 1).Resize(k, 12).Value = kq
MsgBox ("Da Copy " & k & " Dong Moi")
Else
MsgBox ("Khong Co Du Lieu Moi")
End If
End With
Set Dic = Nothing
End Subbác ơi em thấy code của bác đã lọc được mảng kq() là các giá trị chưa có trong sheet1 rồi nhưng em muốn gom các số BH đang trùng nhau lại thành một đơn tổng thôi, ý đồ của em là từ mảng kq() không trùng đó em sẽ tạo ra một dic nữa để cộng tổng các đơn hàng có số BH trùng nhau lại nhưng có 1 đoạn đang bị lỗi, bác giúp em với ạ
Chỉ dùng 1 Dic với Key biến tấu
Sub Loc_Hang_Hoa_test2()
Dim Dic As Object, arr(), kq()
Dim i As Long, lRow As Long, k As Long, ik As Long
Dim iKey As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
lRow = .Range("D65000").End(xlUp).Row
arr = .Range("D1:E" & lRow).Value '"D1:E": Lay dòng tieu de
End With
For i = 2 To UBound(arr) 'i=2: Loai dong tieu de
iKey = arr(i, 1)
If iKey <> Empty Then Dic.Item(iKey & "|") = "" 'Loai dòng trong
Next i
With Sheet10
arr = .Range("A3:Q" & .Range("D65000").End(xlUp).Row).Value
End With
ReDim kq(1 To UBound(arr), 1 To 12)
For i = 1 To UBound(arr)
iKey = arr(i, 4)
If Not Dic.exists(iKey & "|") Then
If Not Dic.exists(iKey) Then
k = k + 1
Dic.Add iKey, k
kq(k, 1) = arr(i, 1)
kq(k, 2) = arr(i, 3)
kq(k, 3) = Format(arr(i, 1), "Tmm/yyyy")
kq(k, 4) = arr(i, 4)
kq(k, 5) = arr(i, 5)
kq(k, 6) = arr(i, 6)
End If
ik = Dic.Item(iKey)
'Chinh các lenh duoi theo dung cot
If Left(iKey, 2) = "BH" Then
kq(ik, 10) = kq(ik, 10) + arr(i, 10)
kq(ik, 12) = kq(ik, 12) + arr(i, 12)
Else
kq(ik, 9) = arr(i, 9) '????
End If
'******
End If
Next i
With Sheet1
If k Then
.Range("A" & lRow + 1).Resize(k, 12).Value = kq
MsgBox ("Da Copy " & k & " Dong Moi")
Else
MsgBox ("Khong Co Du Lieu Moi")
End If
End With
Set Dic = Nothing
End Sub
