Đánh số thứ tự theo điều kiện

[leminhbb]

Mình có giải thuật này hơi khó không biết viết bằng VBA như thế nào cho code chạy nhanh khoảng > 10000 dòng. Các bạn xem rồi hỗ trợ mình với.
Mình có giải thích rõ ràng trong file đính kèm.

Xin cám ơn!

 

[ndu96081631]

Mình có giải thuật này hơi khó không biết viết bằng VBA như thế nào cho code chạy nhanh khoảng > 10000 dòng. Các bạn xem rồi hỗ trợ mình với.
Mình có giải thích rõ ràng trong file đính kèm.

Xin cám ơn!

Xem file bạn tôi chỉ hiểu được:
- Tạo số TT ở sheet HANG
- Điền giá trị vào cột THUTU_HANG và MAHANG tại sheet THUNG
1> Điền số thứ tự tại sheet HANG:

Private Sub Worksheet_Deactivate()
  Range("B2:B65536").ClearContents
  With Range([A2], [A65536].End(xlUp))
    .Offset(, 1).Value = Evaluate("=ROW(R1:R65536)")
  End With
End Sub

2> Điền giá trị vào cột THUTU_HANG và MAHANG tại sheet THUNG

Private Sub CommandButton1_Click()
  Dim SrcRng As Range
  Union([B2:B65536], [E2:E65536]).ClearContents
  Set SrcRng = Sheet1.Range("A1").CurrentRegion
  With Range([A2], [A65536].End(xlUp))
    .Offset(, 1).FormulaArray = "=COUNTIF(INDIRECT(" & Chr(34) & "A2:A" & Chr(34) & "&ROW(" & .Address & "))," & .Address & ")-1"
    .Offset(, 4).FormulaArray = "=VLOOKUP(" & .Address & ",'" & SrcRng.Parent.Name & "'!" & SrcRng.Address & ",2,0)"
    .Offset(, 1).Value = .Offset(, 1).Value
    .Offset(, 4).Value = .Offset(, 4).Value
  End With
End Sub

Thử nghiệm với dử liệu 20.000 dòng --> Chạy vèo vèo
Các câu hỏi khác bạn vui lòng giãi thích thêm ---> KHÔNG HIỂU

 

[ChanhTQ@]

Cột THUTU_HANG là số tăng dần theo cột HANG (bắt đầu từ 0)

Thử xem tốc độ có kém của NDU không nha?!

Sub ThuTuHang()
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim MyAdd As String:                   Dim Dem As Integer
 
 With Sheets("Thung")
    Set Rng = .Range(.[A1], .[A65500].End(xlUp))
 End With
 Sheets("Hang").Select
 For Each Clls In Range("A2:A" & [A65500].End(xlUp).Row)
    Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            sRng.Offset(, 1) = Dem:     Dem = Dem + 1
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Dem = 0
    End If
 Next Clls
End Sub

Cột THUTU_THUNG là số tăng dần của cột THUNG (bắt đầu từ 0) nếu cùng 1 THUNG trong cùng 1 HANG (chú ý có HANG có thể không có THUNG hoặc khác THUNG)

Chưa hiểu, tại sao vầy:

|A|B|C| Yes/No
| Hang | Thung | ThuTuThung |
|. .|. .|. . |
5|A3|L|0|Y
6|A3|L|1|Y
||||
8|A5|S|0|Y
9|A5|S| 2 |No
10|A5|S| 1 | ??
|. .|. .|. . |

 

[leminhbb]

Thử xem tốc độ có kém của NDU không nha?!
Chưa hiểu, tại sao vầy:

|A|B|C| Yes/No
| Hang | Thung | ThuTuThung |
|. .|. .|. . |
5|A3|L|0|Y
6|A3|L|1|Y
||||
8|A5|S|0|Y
9|A5|S| 2 |No
10|A5|S| 1 | ??
|. .|. .|. . |

Mình giải thích lại bên sheet THUNG:
- Cột THUTU_HANG: sẽ tăng dần nếu HANG giống nhau.
- Cột THUTU_THUNG: sẽ tăng dần nếu THUNG là giống nhau (nhưng phải giống HANG thì mới xét)
- ChanhTQ: đó là thứ tự THUNG có thể bị đảo lộn mà không phụ thuộc thứ tự của HANG.

VD: Minh họa chúng ta thấy HANG A1 xuất hiện 2 lần được đánh thứ tự 0->1 tuy nhiên nó ở 2 THUNG khác nhau nên thứ tự THUNG đếm là 0,0.
Đối với HANG A5 thì xuất hiện 3 lần nên có thứ tự là 0->1->2 và được cho vào cùng 1 THUNG là S nên nó đánh thêm số thứ tự THUNG là 0->1->2 nhưng do mình muốn cho vd ko ảnh hưởng bởi thứ tự HANG vì sợ nếu các bạn nghĩ ràng buột sẽ code khó hơn.
Đối với HANG BC xuất hiện 5 lần được đánh số là 0->1->2->3->4 tuy nhiên có 1 lô không đóng thùng còn 4 lô còn lại đóng 2 loại THUNG là F và V nên đánh là V0, V1, F0, F1.
Chắc rối rắm quá nhỉ!

Rất cảm ơn 2 bạn giúp đỡ!

 

[ndu96081631]

Thử xem tốc độ có kém của NDU không nha?!

Sub ThuTuHang()
 Dim Rng As Range, sRng As Range, Clls As Range
 Dim MyAdd As String:                   Dim Dem As Integer
 
 With Sheets("Thung")
    Set Rng = .Range(.[A1], .[A65500].End(xlUp))
 End With
 Sheets("Hang").Select
 For Each Clls In Range("A2:A" & [A65500].End(xlUp).Row)
    Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            sRng.Offset(, 1) = Dem:     Dem = Dem + 1
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        Dem = 0
    End If
 Next Clls
End Sub

Chưa hiểu, tại sao vầy:

|A|B|C| Yes/No
| Hang | Thung | ThuTuThung |
|. .|. .|. . |
5|A3|L|0|Y
6|A3|L|1|Y
||||
8|A5|S|0|Y
9|A5|S| 2 |No
10|A5|S| 1 | ??
|. .|. .|. . |

Em vừa thí nghiệm xong với dử liệu 30.000 dòng cho cả 2 sheeet... Kết quả như sau:
- Code của em chạy xong trong khoảng từ 25s đến 40s
- Code của anh.... Hic... Hic... đến giờ vẫn chưa xong!... Em đành phải Ctrl + Break chạy thoát thân
Em nghĩ dùng FOR khó có thể nhanh hơn việc gán công thức vào cell rồi chuyển sang Value (mà code anh lại dùng đến 2 vòng lập)
Anh Test thử xem!

 

[rollover79]

Em vừa thí nghiệm xong với dử liệu 30.000 dòng cho cả 2 sheeet... Kết quả như sau:
- Code của em chạy xong trong khoảng từ 25s đến 40s
- Code của anh.... Hic... Hic... đến giờ vẫn chưa xong!... Em đành phải Ctrl + Break chạy thoát thân
Em nghĩ dùng FOR khó có thể nhanh hơn việc gán công thức vào cell rồi chuyển sang Value (mà code anh lại dùng đến 2 vòng lập)
Anh Test thử xem!

Nhờ bác ndu test giúp em macro này xem tốc độ ra sao. Em có dùng 1 Name tên là TenHang là vùng chứa tên các mặt hàng trong Sheet HANG(Như trong file nó có địa chỉ là A2:A11)

Sub Roll()
    Dim SoHang As Long
    SoHang = Range("TenHang").Count
    Dim arr() As Long
    Dim i As Long
    Dim Pos As Long
    For i = 1 To SoHang
        ReDim arr(1 To i)
    Next
    For i = 2 To [A65536].End(xlUp).Row
        Pos = WorksheetFunction.Match(Cells(i, 1), Range("TenHang"), 0)
        Cells(i, 2) = arr(Pos)
        arr(Pos) = arr(Pos) + 1
    Next
End Sub

 

[ndu96081631]

Nhờ bác ndu test giúp em macro này xem tốc độ ra sao. Em có dùng 1 Name tên là TenHang là vùng chứa tên các mặt hàng trong Sheet HANG(Như trong file nó có địa chỉ là A2:A11)

Sub Roll()
    Dim SoHang As Long
    SoHang = Range("TenHang").Count
    Dim arr() As Long
    Dim i As Long
    Dim Pos As Long
    For i = 1 To SoHang
        ReDim arr(1 To i)
    Next
    For i = 2 To [A65536].End(xlUp).Row
        Pos = WorksheetFunction.Match(Cells(i, 1), Range("TenHang"), 0)
        Cells(i, 2) = arr(Pos)
        arr(Pos) = arr(Pos) + 1
    Next
End Sub

Vừa test xong ---> Tốc độ hơi bị ấn tượng ---> dử liệu vẫn là 30.000 dòng trên 2 sheet ---> Tốc độ khoảng 15s
Ẹc... Ẹc...

 

[rollover79]

Vừa test xong ---> Tốc độ hơi bị ấn tượng ---> dử liệu vẫn là 30.000 dòng trên 2 sheet ---> Tốc độ khoảng 15s
Ẹc... Ẹc...

Em chưa hiểu ý bác nói trên 2 sheet là thế nào? Có phải ý bác là bên sheet HANG bác có 30.000 mặt hàng không? Nếu đúng thì có vẻ ... hơi nhiều quá nhỉ. Em hỏi vậy vì code của bác tốc độ không phụ thuộc vào số lượng tên hàng. Còn của em thì lại phụ thuộc vào số lượng tên hàng khá nhiều. Nên khi test code của bác thì số dòng bên sheet HANG không quan trọng.

 

[ndu96081631]

Em chưa hiểu ý bác nói trên 2 sheet là thế nào? Có phải ý bác là bên sheet HANG bác có 30.000 mặt hàng không? Nếu đúng thì có vẻ ... hơi nhiều quá nhỉ. Em hỏi vậy vì code của bác tốc độ không phụ thuộc vào số lượng tên hàng. Còn của em thì lại phụ thuộc vào số lượng tên hàng khá nhiều. Nên khi test code của bác thì số dòng bên sheet HANG không quan trọng.

Đúng vậy! Code của tôi không phụ thuộc vào sheet HÀNG
Số là file đầu tiên của tôi còn có code cho cột MÃ HÀNG nữa ---> Mà code này thì phụ thuộc vào sheet HÀNG ---> Trong quá trình test, tôi thêm dử liệu vào cả 2 sheet và giữ nguyên thế