Dùng vòng lặp để tách mỗi lần 3 giá trị của 1 mã cho đến hết

[Quangdz0512]

Hiện em có 1 tính huống, mong muốn dùng vòng lặp để tách mỗi lần 3 serial của 1 mã hàng mang đi, nếu số lượng serial không chia hết cho 3 thì lần cuối cùng sẽ lấy số còn lại.
Chi tiết như ví dụ đính kèm.
Em không chú trọng vào việc để dữ liệu vào đâu, nên việc trình bày kết quả mong muốn này tại sheet1 đó chỉ là minh họa, vì mỗi lần mang đi đó em đưa vào nhiều file khác nhau và bố trí không theo quy tắc nào cả. Chỉ mong muốn vòng lặp cho mỗi mã, hết mã này tới mã khác.
Em cảm ơn.

 

[Phuocam]

Hiện em có 1 tính huống, mong muốn dùng vòng lặp để tách mỗi lần 3 serial của 1 mã hàng mang đi, nếu số lượng serial không chia hết cho 3 thì lần cuối cùng sẽ lấy số còn lại.
Chi tiết như ví dụ đính kèm.
Em không chú trọng vào việc để dữ liệu vào đâu, nên việc trình bày kết quả mong muốn này tại sheet1 đó chỉ là minh họa, vì mỗi lần mang đi đó em đưa vào nhiều file khác nhau và bố trí không theo quy tắc nào cả. Chỉ mong muốn vòng lặp cho mỗi mã, hết mã này tới mã khác.
Em cảm ơn.

Có thể ý tưởng code là vậy:

Public Sub test()
' d là số lượng dòng của 1 mã,
r = 1
c = 1
Do While d > 0
    If d > 3 Then
        d = 1
        c = c + 1
        '.... ghi dữ liệu
    End If
    d = d - 1
Loop
End Sub

 

[Quangdz0512]

Có thể ý tưởng code là vậy:

Public Sub test()
' d là số lượng dòng của 1 mã,
r = 1
c = 1
Do While d > 0
    If d > 3 Then
        d = 1
        c = c + 1
        '.... ghi dữ liệu
    End If
    d = d - 1
Loop
End Sub

Em quên mất, còn vụ tìm số lượng của mỗi mã nữa, anh có cách nào tìm nhanh không, em dùng worksheetFunction có vẻ không linh hoạt

 

[Phuocam]

Em quên mất, còn vụ tìm số lượng của mỗi mã nữa, anh có cách nào tìm nhanh không, em dùng worksheetFunction có vẻ không linh hoạt

.
Nếu dữ liệu đã sắp xếp, có thể dùng biến Ma as string, so sánh mã hiện tại với mã mẫu. Nếu khác mã, gán mã mới vào Ma và làm lại.
.

 

[Hoàng Tuấn 868]

Em quên mất

Nếu có trường hợp số lượng 1 mã nhỏ hơn 3 thì sẽ thế nào bạn nhỉ?

 

[Quangdz0512]

Em vẫn chưa rõ lắm, anh có thể cho em bộ code hoàn chỉnh không ạ? Cảm ơn anh

Bài đã được tự động gộp: 29/7/23

Nếu có trường hợp số lượng 1 mã nhỏ hơn 3 thì sẽ thế nào bạn nhỉ?

Trong file em có ví dụ cụ thể ạ. Nếu số lượng 1 mã nhỏ hơn 3 thì sẽ chỉ lấy số lượng đó thôi ạ

 

[Nhattanktnn]

Em vẫn chưa rõ lắm, anh có thể cho em bộ code hoàn chỉnh không ạ? Cảm ơn anh

Bài đã được tự động gộp: 29/7/23

Trong file em có ví dụ cụ thể ạ. Nếu số lượng 1 mã nhỏ hơn 3 thì sẽ chỉ lấy số lượng đó thôi ạ

Bạn thử code này xem sao:

Sub abc()
Dim a(), b(), i&, mr&, mc&, k&, r&, c&, count&, id$
Const rs& = 3
With Sheets("Sheet1")
    a = .Range("A4:B" & .Cells(Rows.count, "B").End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 10)
    For i = 1 To UBound(a)
        If a(i, 1) <> "" And a(i, 1) <> id Then
            id = a(i, 1)
            k = mr
            count = 1
        Else
            count = count + 1
        End If
        c = (count - 1) \ rs + 2
        r = (count - 1) Mod rs + 1
        If k + r > mr Then mr = k + r
        If c > mc Then mc = c
        If c > UBound(b, 2) Then ReDim Preserve b(1 To UBound(a), 1 To UBound(b, 2) + 10)
        If r = 1 And c = 2 Then b(k + r, 1) = id
        b(k + r, c) = a(i, 2)
    Next
    .Range("N3").Resize(10000, 100).ClearContents
    .Range("N3").Resize(mr, mc) = b
End With
End Sub

 

[Hoàng Tuấn 868]

Bạn thử code này xem sao:

Sub abc()
Dim a(), b(), i&, mr&, mc&, k&, r&, c&, count&, id$
Const rs& = 3
With Sheets("Sheet1")
    a = .Range("A4:B" & .Cells(Rows.count, "B").End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 10)
    For i = 1 To UBound(a)
        If a(i, 1) <> "" And a(i, 1) <> id Then
            id = a(i, 1)
            k = mr
            count = 1
        Else
            count = count + 1
        End If
        c = (count - 1) \ rs + 2
        r = (count - 1) Mod rs + 1
        If k + r > mr Then mr = k + r
        If c > mc Then mc = c
        If c > UBound(b, 2) Then ReDim Preserve b(1 To UBound(a), 1 To UBound(b, 2) + 10)
        If r = 1 And c = 2 Then b(k + r, 1) = id
        b(k + r, c) = a(i, 2)
    Next
    .Range("N3").Resize(10000, 100).ClearContents
    .Range("N3").Resize(mr, mc) = b
End With
End Sub

Nhỡ số lượng 1 mã lớn hơn 30 thì tèo mất nhỉ.

 

[Nhattanktnn]

Nhỡ số lượng 1 mã lớn hơn 30 thì tèo mất nhỉ.

Tèo sao anh nhỉ? Có redim lại mở rộng mảng mà anh

 

[Hoàng Tuấn 868]

Tèo sao anh nhỉ? Anh lấy ví dụ em kiểm tra thử

Chỗ này: ReDim b(1 To UBound(a), 1 To 10)
Số cột có 10 nhé, nếu số lượng 1 mã là 31 chia cho 3 thì được 10 cột, còn lại vẫn dư 1 thì sẽ thiếu cột.

 

[Nhattanktnn]

Chỗ này: ReDim b(1 To UBound(a), 1 To 10)
Số cột có 10 nhé, nếu số lượng 1 mã là 31 chia cho 3 thì được 10 cột, còn lại vẫn dư 1 thì sẽ thiếu cột.

Anh cứ test kỹ nhé, em tính cả rồi

 

[Hoàng Tuấn 868]

Anh cứ test kỹ nhé, em tính cả rồi

Hì hì, ban nãy chưa đọc đến đoạn này:
If c > UBound(b, 2) Then ReDim Preserve b(1 To UBound(a), 1 To UBound(b, 2) + 10)

 

[BuiQuangThuan]

@Nhattanktnn Cột A không được sort. Data ở rải rác thì có vẻ kết quả nó không theo ý mình ấy nhỉ

 

[Nhattanktnn]

@Nhattanktnn Cột A không được sort. Data ở rải rác thì có vẻ kết quả nó không theo ý mình ấy nhỉ

Làm theo dữ liệu thôi bạn, không được sort thì phải sửa code rồi

 

[Quangdz0512]

Bạn thử code này xem sao:

Sub abc()
Dim a(), b(), i&, mr&, mc&, k&, r&, c&, count&, id$
Const rs& = 3
With Sheets("Sheet1")
    a = .Range("A4:B" & .Cells(Rows.count, "B").End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 10)
    For i = 1 To UBound(a)
        If a(i, 1) <> "" And a(i, 1) <> id Then
            id = a(i, 1)
            k = mr
            count = 1
        Else
            count = count + 1
        End If
        c = (count - 1) \ rs + 2
        r = (count - 1) Mod rs + 1
        If k + r > mr Then mr = k + r
        If c > mc Then mc = c
        If c > UBound(b, 2) Then ReDim Preserve b(1 To UBound(a), 1 To UBound(b, 2) + 10)
        If r = 1 And c = 2 Then b(k + r, 1) = id
        b(k + r, c) = a(i, 2)
    Next
    .Range("N3").Resize(10000, 100).ClearContents
    .Range("N3").Resize(mr, mc) = b
End With
End Sub

Cảm ơn anh @Nhattanktnn
Kết quả đúng với mô tả của file rồi ạ, và dữ liệu của em luôn được sắp xếp theo từng mã rồi (thể hiện tại cột E và F - Có thể để mã 1 lần duy nhất tại vị trí Serial đầu tiên)
Tuy nhiên mong muốn của em ở đây là em không chú trọng vào việc dán kết quả theo đúng định dạng đó, mà là em muốn 1 vòng lặp với các mã.
Ví dụ Mã A em sẽ copy nhiều nhất là 3 serial, có thể dán ở bất kỳ chỗ nào, xong lại quay ra copy 3 serial tiếp theo để dán vào chỗ khác (nếu số lượng serial nhỏ hơn 3 thì chỉ lấy phần đó thôi - tức có bao nhiêu lấy bấy nhiêu). Rồi lại tiếp tục với mã tiếp theo là B cho đến hết ạ.

 

[Nhattanktnn]

Cảm ơn anh @Nhattanktnn
Kết quả đúng với mô tả của file rồi ạ, và dữ liệu của em luôn được sắp xếp theo từng mã rồi (thể hiện tại cột E và F - Có thể để mã 1 lần duy nhất tại vị trí Serial đầu tiên)
Tuy nhiên mong muốn của em ở đây là em không chú trọng vào việc dán kết quả theo đúng định dạng đó, mà là em muốn 1 vòng lặp với các mã.
Ví dụ Mã A em sẽ copy nhiều nhất là 3 serial, có thể dán ở bất kỳ chỗ nào, xong lại quay ra copy 3 serial tiếp theo để dán vào chỗ khác (nếu số lượng serial nhỏ hơn 3 thì chỉ lấy phần đó thôi - tức có bao nhiêu lấy bấy nhiêu). Rồi lại tiếp tục với mã tiếp theo là B cho đến hết ạ.

Ý bạn là bạn sẽ đưa đầu vào là một mã bất kỳ, và code sẽ duyệt lần 3 serial của mã đó (nếu thừa thiếu thì xử lý như đã nói) ?

 

[Quangdz0512]

Ý bạn là bạn sẽ đưa đầu vào là một mã bất kỳ, và code sẽ duyệt lần 3 serial của mã đó (nếu thừa thiếu thì xử lý như đã nói) ?

Dạ, chạy các mã lần lượt từ đầu đến cuối luôn ạ. Không phải đưa đầu vào nữa mà duyệt qua từng mã trong cột A luôn ạ.

 

[Nhattanktnn]

Dạ, chạy các mã lần lượt từ đầu đến cuối luôn ạ. Không phải đưa đầu vào nữa mà duyệt qua từng mã trong cột A luôn ạ.

Bạn ví dụ sát thực tế xem nào, mình chưa rõ ý lắm. Code trên cũng lặp qua từng mã (đã sort) rồi đấy, bắt đầu mã là khi nó vào if này : If a(i, 1) <> "" And a(i, 1) <> id Then
Kết thúc mã cũng chính là trước khi nó vào if phía trên (dòng i-1) với i<>1

 

[Quangdz0512]

Bạn ví dụ sát thực tế xem nào, mình chưa rõ ý lắm. Code trên cũng lặp qua từng mã (đã sort) rồi đấy, bắt đầu mã là khi nó vào if này : If a(i, 1) <> "" And a(i, 1) <> id Then
Kết thúc mã cũng chính là trước khi nó vào if phía trên (dòng i-1) với i<>1

Vâng, có thể do văn phong lủng củng nên em mô tả chưa rõ ạ.
Các đích đến của em có thể là nhiều file, nhiều sheet khác nhau.
Anh có cách nào cho lặp như thế này không ạ.

Lặp qua mỗi Mã,
Mã A - Đếm xem A có bao nhiêu Serial, nếu > 3 serial thì copy số lần là INT(Số lượng serial/3) +1. Trong đó các lần trước là 3 serial/lần, lần cuối cùng là số serial = Mod(Số lượng serial,3)

Ví dụ mã A có 4 mã, sẽ phải copy 2 lần. Lần 1 lấy 3 mã dán vào ô N2, lần 2 có 1 mã dán vào ô O4

Tiếp tục đến mã B và tương tự lặp đến hết các mã.
Nếu số lượng serial của 1 mã mà < 3 thì chỉ copy 1 lần dán vào ô Q3

Với trường hợp muốn kiểm tra thực tế, thì cần thử với 2 mã A và B thôi ạ, vì đích đến sẽ để ở 3 ô cho dễ hình dung theo file đính kèm ạ.

 

[Phuocam]

có thể dán ở bất kỳ chỗ nào, xong lại quay ra copy 3 serial tiếp theo để dán vào chỗ khác

.
Cái này là cái bạn đang tìm?

Application.InputBox(Prompt:="Chon vung muon dan du lieu", Title:="Thong bao", Type:=8)

.