Nhờ hướng dẫn cách viết code chia nhóm có điều kiện

Vocamthuy

Thành viên mới
Tham gia ngày
8 Tháng một 2020
Bài viết
8
Được thích
0
Điểm
13
Tuổi
27
Xin chào các anh chị !
Em mới làm quen với VBA nên còn nhiều điều chưa nắm rõ, mong nhận được sự chỉ giáo, giúp đỡ từ các anh chị.
Em có file tổng hợp hơn 70.000 email, cần chia thành từng nhóm. Điều kiện như sau:
- Mỗi nhóm có 1.000 email (Cột B)
- Trong 1 nhóm không được trùng địa chỉ của đuôi mail (Cột A)
- Sau khi chia xong thì điền số thứ tự của nhóm vào Cột M

Rất mong nhận được sự giúp đỡ của các anh chị.
Em cảm ơn nhiều ạ !
 

File đính kèm

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,408
Được thích
2,276
Điểm
360
Xin chào các anh chị !
Em mới làm quen với VBA nên còn nhiều điều chưa nắm rõ, mong nhận được sự chỉ giáo, giúp đỡ từ các anh chị.
Em có file tổng hợp hơn 70.000 email, cần chia thành từng nhóm. Điều kiện như sau:
- Mỗi nhóm có 1.000 email (Cột B)
- Trong 1 nhóm không được trùng địa chỉ của đuôi mail (Cột A)
- Sau khi chia xong thì điền số thứ tự của nhóm vào Cột M

Rất mong nhận được sự giúp đỡ của các anh chị.
Em cảm ơn nhiều ạ !
Cho mình hỏi cái chỉ cần chia nhóm và điền vào cột M đúng không.Mà nó có trùng maile không.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,408
Được thích
2,276
Điểm
360
Mình đã lọc mail trùng rồi. Giờ cần chia nhóm theo 2 điều kiện như mình đã viết và điền tên nhóm vào cột M.
Bạn thử cái code ngu ngu này xem nhé.Chỗ cuối nó chia sao không đúng lắm.Để mình kiểm tra lại.
Mã:
Sub diennhom()
    Dim lr As Long, i As Long, arr, kq, dk As String, dks As String, dic As Object, b As Long, c As Long, a As Long, nhom As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("list tong")
         nhom = 1
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:B" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 1)
         Do
         For i = 1 To UBound(arr)
          If kq(i, 1) = Empty Then
             dk = arr(i, 1)
             dks = arr(i, 2)
             If Not dic.exists(dk) Then
                b = b + 1
                a = a + 1
                If a = 1001 Then a = 1: nhom = nhom + 1
                kq(i, 1) = nhom
                dic.Add dk, Array(a, 1)
             End If
          End If
       Next i
       dic.RemoveAll
       Loop Until b = UBound(arr)
       .Range("m2:m" & lr).Value = kq
   End With
End Sub
 

Vocamthuy

Thành viên mới
Tham gia ngày
8 Tháng một 2020
Bài viết
8
Được thích
0
Điểm
13
Tuổi
27
Bạn thử cái code ngu ngu này xem nhé.Chỗ cuối nó chia sao không đúng lắm.Để mình kiểm tra lại.
Mã:
Sub diennhom()
    Dim lr As Long, i As Long, arr, kq, dk As String, dks As String, dic As Object, b As Long, c As Long, a As Long, nhom As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("list tong")
         nhom = 1
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:B" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 1)
         Do
         For i = 1 To UBound(arr)
          If kq(i, 1) = Empty Then
             dk = arr(i, 1)
             dks = arr(i, 2)
             If Not dic.exists(dk) Then
                b = b + 1
                a = a + 1
                If a = 1001 Then a = 1: nhom = nhom + 1
                kq(i, 1) = nhom
                dic.Add dk, Array(a, 1)
             End If
          End If
       Next i
       dic.RemoveAll
       Loop Until b = UBound(arr)
       .Range("m2:m" & lr).Value = kq
   End With
End Sub
Cảm ơn bạn đã giúp đỡ nha ! :)
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,277
Được thích
16,080
Điểm
1,860
Tuổi
60
Nơi ở
An Giang
- Mỗi nhóm có 1.000 email (Cột B)
- Trong 1 nhóm không được trùng địa chỉ của đuôi mail (Cột A)
- Sau khi chia xong thì điền số thứ tự của nhóm vào Cột M
Mỗi nhóm không được trùng cột A, như vậy có thể có nhóm không đủ 1000, thậm chí chỉ có 1 dữ liệu cột A.
 

Vocamthuy

Thành viên mới
Tham gia ngày
8 Tháng một 2020
Bài viết
8
Được thích
0
Điểm
13
Tuổi
27
Mỗi nhóm không được trùng cột A, như vậy có thể có nhóm không đủ 1000, thậm chí chỉ có 1 dữ liệu cột A.
Dạ đúng vậy, những nhóm đầu chia đúng cả 2 điều kiện, nhưng nhóm cuối nếu muốn đủ 1000 mail thì chắc chắn bị trùng cột A hoặc muốn không bị trùng thì sẽ không đủ 1000 mail.
Dữ liệu của em cũng ko đc chuẩn xác nên theo code bạn Snow25 hướng dẫn, kết quả vượt quá mong đợi của em rồi.
Cảm ơn anh chị rất nhiều ạ !
 

Vocamthuy

Thành viên mới
Tham gia ngày
8 Tháng một 2020
Bài viết
8
Được thích
0
Điểm
13
Tuổi
27
Bạn thử cái code ngu ngu này xem nhé.Chỗ cuối nó chia sao không đúng lắm.Để mình kiểm tra lại.
Mã:
Sub diennhom()
    Dim lr As Long, i As Long, arr, kq, dk As String, dks As String, dic As Object, b As Long, c As Long, a As Long, nhom As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("list tong")
         nhom = 1
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:B" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 1)
         Do
         For i = 1 To UBound(arr)
          If kq(i, 1) = Empty Then
             dk = arr(i, 1)
             dks = arr(i, 2)
             If Not dic.exists(dk) Then
                b = b + 1
                a = a + 1
                If a = 1001 Then a = 1: nhom = nhom + 1
                kq(i, 1) = nhom
                dic.Add dk, Array(a, 1)
             End If
          End If
       Next i
       dic.RemoveAll
       Loop Until b = UBound(arr)
       .Range("m2:m" & lr).Value = kq
   End With
End Sub
Bạn ơi cho mình hỏi, nếu mình sắp xếp những đuôi mail giống nhau (Cột A) thành từng nhóm rồi đánh số thứ tự "n" cho từng mail (Cột B) trong nhóm, sau đó điền số thứ tự "n" vào cột M, (lúc đó số "n" chính là số thứ tự của nhóm mà mình muốn chia, và ko cố định mỗi nhóm là 1000 mail nữa). Bạn có thể hướng dẫn mình code cho cách này được không ?
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,408
Được thích
2,276
Điểm
360
Bạn ơi cho mình hỏi, nếu mình sắp xếp những đuôi mail giống nhau (Cột A) thành từng nhóm rồi đánh số thứ tự "n" cho từng mail (Cột B) trong nhóm, sau đó điền số thứ tự "n" vào cột M, (lúc đó số "n" chính là số thứ tự của nhóm mà mình muốn chia, và ko cố định mỗi nhóm là 1000 mail nữa). Bạn có thể hướng dẫn mình code cho cách này được không ?
Không hiểu lắm bạn cho ví dụ cụ thể xem nhé.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,408
Được thích
2,276
Điểm
360
View attachment 231003
Cột A: đuôi mail giống nhau thành 1 nhóm
Cột B: đánh số thứ tự cho mail trong nhóm đuôi mail trùng nhau và điền vào cột M
Sorry bạn nha :)
Bạn thử code này nhé.Không cần sắp xếp cũng được.
Mã:
Sub test()
   Dim arr, i As Long, dk As String, a As Long, dic As Object, kq, lr As Long
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("list tong")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:A" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, 1
               kq(i, 1) = 1
            Else
               a = dic.Item(dk) + 1
               kq(i, 1) = a
               dic.Item(dk) = a
            End If
        Next i
        .Range("m2:m" & lr).Value = kq
 End With
End Sub
 

Vocamthuy

Thành viên mới
Tham gia ngày
8 Tháng một 2020
Bài viết
8
Được thích
0
Điểm
13
Tuổi
27
Bạn thử code này nhé.Không cần sắp xếp cũng được.
Mã:
Sub test()
   Dim arr, i As Long, dk As String, a As Long, dic As Object, kq, lr As Long
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("list tong")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:A" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, 1
               kq(i, 1) = 1
            Else
               a = dic.Item(dk) + 1
               kq(i, 1) = a
               dic.Item(dk) = a
            End If
        Next i
        .Range("m2:m" & lr).Value = kq
End With
End Sub
Ok, mình chạy được rồi. Cảm ơn bạn nhiều nha !
 

ppc0312

whom?
Tham gia ngày
2 Tháng tư 2008
Bài viết
354
Được thích
150
Điểm
695
Chia mail để làm gì?
Đây là bài toán khác mà đáo hình, hay là bài toán mail spam / hack email?
 
Lần chỉnh sửa cuối:

Vocamthuy

Thành viên mới
Tham gia ngày
8 Tháng một 2020
Bài viết
8
Được thích
0
Điểm
13
Tuổi
27
Chia mail để làm gì?
Đây là bài toán khác mà đáo hình, hay là bài toán mail spam / hack email?
Dạ, vì em có plan gửi mail marketing cho khách hàng với điều kiện là gửi theo từng nhóm.
Danh sách mail đều là khách hàng của công ty, nhờ code sẽ hỗ trợ việc chia nhóm được nhanh và chuẩn xác hơn.
Cảm ơn anh/chị đã quan tâm và thẳng thắn đưa ra vấn đề.
Em chỉ suy nghĩ đơn giản là hỏi những điều mình còn thiếu kinh nghiệm và cũng rất mong được anh/chị giúp đỡ.
 
Top Bottom