Cần trợ giúp về so sánh để lấy dữ liệu

Liên hệ QC

ducmagic88

Thành viên chính thức
Tham gia
14/4/20
Bài viết
65
Được thích
4
Chào các bác ạ! các bác ơi em đang vướng một vấn đề là lấy dữ liệu lần đầu từ sheet dữ liệu sang sheet đích thì vô tư nhưng nếu bây giờ có thêm dữ liệu mới thì em không biết cách để loại đi dữ liệu cũ, chỉ lấy dữ liệu mới phát sinh sang sheet đích. Các bác giúp em với, em cảm ơn ạ!
Lưu ý: Em đang viết code ở "module 4 sub Loc_Hang_Hoa" ạ.
 

File đính kèm

  • CONG_NO.xlsm
    420.4 KB · Đọc: 12
Chào các bác ạ! các bác ơi em đang vướng một vấn đề là lấy dữ liệu lần đầu từ sheet dữ liệu sang sheet đích thì vô tư nhưng nếu bây giờ có thêm dữ liệu mới thì em không biết cách để loại đi dữ liệu cũ, chỉ lấy dữ liệu mới phát sinh sang sheet đích. Các bác giúp em với, em cảm ơn ạ!
Lưu ý: Em đang viết code ở "module 4 sub Loc_Hang_Hoa" ạ.
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.

Mã:
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
 
Upvote 0
Mình thấy bạn viết thế này thì rối rắm & hàn lâm thế nào đó, khó hiểu thiệt:
PHP:
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
' . . . . . '
 
Lần chỉnh sửa cuối:
Upvote 0
Mình thấy bạn viết thế này thì rối rắm & hàn lâm thế nào đó, khó hiểu thiệt:
PHP:
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
    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
 
Upvote 0
Mình mới cho trình biên dịch chạy thì báo lỗi ở dòng mà mình vừa bổ sung trong đoạn Code nêu trên; File bạn có thế không?
 
Upvote 0
Thường thì viết chân phương để chương trình chạy đúng ý cái đã; Sau đó ta 'Hàn lâm' nó sau

Trong khi viết cần xem lại kết quả từng câu lệnh để phát hiện sai sót, dễ nhất là xài MsgBox XYZ
Với bạn xin đề nghị kiểm tra ở từng thời điểm mảng Arr() đã khai báo & nạp nguyên liệu cho nó.

Kiểu viết của bạn mình dị ứng, nên sẽ không thể viết gì thêm!
 
Upvote 0
Thường thì viết chân phương để chương trình chạy đúng ý cái đã; Sau đó ta 'Hàn lâm' nó sau

Trong khi viết cần xem lại kết quả từng câu lệnh để phát hiện sai sót, dễ nhất là xài MsgBox XYZ
Với bạn xin đề nghị kiểm tra ở từng thời điểm mảng Arr() đã khai báo & nạp nguyên liệu cho nó.

Kiểu viết của bạn mình dị ứng, nên sẽ không thể viết gì thêm!
để 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 ạ.
 
Upvote 0
Chào các bác ạ! các bác ơi em đang vướng một vấn đề là lấy dữ liệu lần đầu từ sheet dữ liệu sang sheet đích thì vô tư nhưng nếu bây giờ có thêm dữ liệu mới thì em không biết cách để loại đi dữ liệu cũ, chỉ lấy dữ liệu mới phát sinh sang sheet đích. Các bác giúp em với, em cảm ơn ạ!
Lưu ý: Em đang viết code ở "module 4 sub Loc_Hang_Hoa" ạ.
Tự viết thêm lệnh gán mảng kết quả
Mã:
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 Sub
 
Upvote 0
Tự viết thêm lệnh gán mảng kết quả
Mã:
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 Sub
Bá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 ạ.
 
Upvote 0
Bá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
 
Upvote 0
Đã loại dữ liệu trùng sheet đích rồi
1591285750745.png
Bác ơi code bác cho em chạy thử được rồi nhưng lại có 1 lỗi là nếu chỉ có 1 dòng thì nó lại báo lỗi như thế này. Kể cả code của em cho sheet khác cũng bị vậy,, không biết lỗi này là lỗi gì vậy bác nhỉ?
 

File đính kèm

  • FILE_CONG_NO_VBA.xlsm
    495 KB · Đọc: 5
Upvote 0
View attachment 238726
Bác ơi code bác cho em chạy thử được rồi nhưng lại có 1 lỗi là nếu chỉ có 1 dòng thì nó lại báo lỗi như thế này. Kể cả code của em cho sheet khác cũng bị vậy,, không biết lỗi này là lỗi gì vậy bác nhỉ?
Chỉnh lại code
Mã:
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 Sub
 
Upvote 0
Chỉnh lại code
Mã:
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 Sub
bá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 ạ
Bài đã được tự động gộp:

 

File đính kèm

  • CONG_NO.xlsm
    415.7 KB · Đọc: 7
Upvote 0
bá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 ạ
Bài đã được tự động gộp:
Chỉ dùng 1 Dic với Key biến tấu
Có 1 số cột tính khá lạ, tự chỉnh lại
Mã:
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
 
Upvote 0
Web KT
Back
Top Bottom