Nối chuỗi dữ liệu theo điều kiện

[ngocthach90]

Có đoạn code nào để cứ mỗi 20 ô dữ liệu sẽ được nối lại với nhau bằng dấu phẩy không?
Các anh chị chỉ giúp em ạ. Em cảm ơn!

 

[cantl]

Có đoạn code nào để cứ mỗi 20 ô dữ liệu sẽ được nối lại với nhau bằng dấu phẩy không?
Các anh chị chỉ giúp em ạ. Em cảm ơn!

Hình như cái này dùng offset được đấy. Ngủ đã.

 

[BuiQuangThuan]

Có đoạn code nào để cứ mỗi 20 ô dữ liệu sẽ được nối lại với nhau bằng dấu phẩy không?
Các anh chị chỉ giúp em ạ. Em cảm ơn!

Thử code này coi đúng ý không?

Sub ABC()
    Dim i&, iR&, Res(), k&
    With Sheets("Sheet1")
        iR = .Range("A" & Rows.Count).End(3).Row
        ReDim Res(1 To Int((iR - 1) / 20) + 1, 1 To 1)
        For i = 2 To iR Step 20
            k = k + 1
            Res(k, 1) = WorksheetFunction.TextJoin(",", True, .Cells(i, 1).Resize(20))
        Next
        .Range("G4").Resize(k, 1).Value = Res
    End With
End Sub

 

[tranchautrungduong]

Có đoạn code nào để cứ mỗi 20 ô dữ liệu sẽ được nối lại với nhau bằng dấu phẩy không?
Các anh chị chỉ giúp em ạ. Em cảm ơn!

của bạn đây, dùng office 365, 2019 trở lên nhé.

=TEXTJOIN(",",TRUE,TRANSPOSE(OFFSET(A2,IF(ROWS($F$17:$F17)>1,(ROWS($F$17:$F17)-1)*19,ROWS($F$17:$F17)-1),0,20,1)))

 

[longtay1111]

Có đoạn code nào để cứ mỗi 20 ô dữ liệu sẽ được nối lại với nhau bằng dấu phẩy không?
Các anh chị chỉ giúp em ạ. Em cảm ơn!

Bạn dùng 365 thì thế này nhé TEXTJOIN(",",1,OFFSET($A$1,1+(20*ROW(A1)-20),0,20,1))

Có đoạn code nào để cứ mỗi 20 ô dữ liệu sẽ được nối lại với nhau bằng dấu phẩy không?
Các anh chị chỉ giúp em ạ. Em cảm ơn!

 

[Hoàng Tuấn 868]

Bạn dùng 365 thì thế này nhé TEXTJOIN(",",1,OFFSET($A$1,1+(20*ROW(A1)-20),0,20,1))

Bạn cho mình xin công thức với office 2016 nhé, xin cảm ơn bạn.

 

[longtay1111]

Bạn cho mình xin công thức với office 2016 nhé, xin cảm ơn bạn.

2016 thì em chịu bác ơi

 

[Nhattanktnn]

Thử code này coi đúng ý không?

Sub ABC()
    Dim i&, iR&, Res(), k&
    With Sheets("Sheet1")
        iR = .Range("A" & Rows.Count).End(3).Row
        ReDim Res(1 To Int((iR - 1) / 20) + 1, 1 To 1)
        For i = 2 To iR Step 20
            k = k + 1
            Res(k, 1) = WorksheetFunction.TextJoin(",", True, .Cells(i, 1).Resize(20))
        Next
        .Range("G4").Resize(k, 1).Value = Res
    End With
End Sub

Mình chưa xem file nhưng sao đã code lại còn dùng textjoin thế bạn? Nó lại phải phụ thuộc vào office rồi
VBA có hàm join mà

 

[tranchautrungduong]

Bạn cho mình xin công thức với office 2016 nhé, xin cảm ơn bạn.

Hình như có đó bạn.

Hàm TEXTJOIN có sẵn trong Excel 365, Excel 2016, Excel 2019​

 

[Hoàng Tuấn 868]

Hình như có đó bạn.

Excel 2016​

Trong máy mình không thấy có nên mới nhờ bạn.

 

[tranchautrungduong]

Trong máy mình không thấy có nên mới nhờ bạn.

Nếu đã vậy, mỗi dòng bạn cách nhau 1 dòng bằng dấu ,

rồi làm với 40

=CONCAT(TRANSPOSE(OFFSET(A1,IF(ROWS($A$1:$A1)>1,(ROWS($A$1:$A1)-1)*39,ROWS($A$1:$A1)-1),0,39,1)))

 

[Nhattanktnn]

Bạn cho mình xin công thức với office 2016 nhé, xin cảm ơn bạn.

2016 thì em không có office đó, nên viết thử bác dùng xem có được không?

=MID(CONCAT(","&OFFSET(A2,(ROWS($A$2:A2)-1)*20,,20)),2,1000)

 

[tranchautrungduong]

=MID(CONCAT(","&OFFSET(A2,(ROWS($A$2:A2)-1)*20,,20)),2,1000)

*19 thôi nha. với cách này khi hết list nó cứ hiện dấu , rất nhiều.

 

[Nhattanktnn]

*19 thôi nha

Thực ra cái ý đồ của mình lúc đầu không sai, mà quên không cố định ô A6

với cách này khi hết list nó cứ hiện dấu , rất nhiều

Đúng rồi, cái này bác mà mình giúp dư sức xử.
Mà thôi mình sửa lại luôn:

=SUBSTITUTE(TRIM(CONCAT(" "&OFFSET($A$6,(ROWS($A$6:A6)-1)*20,,20)))," ",",")

 

[BuiQuangThuan]

Mình chưa xem file nhưng sao đã code lại còn dùng textjoin thế bạn? Nó lại phải phụ thuộc vào office rồi
VBA có hàm join mà

Quên anh ạ. hihi........... .....

 

[cantl]

Sau khi ngủ dậy, mò cả buổi sáng mới ra được. Cũng nhờ tham khảo bài của anh em bên trên.
Hỏi: em dùng hàm gì.
Trả lời: concat.

G4=CONCAT(OFFSET($A$1;20*(ROW()-3);0;-20;1)&", ")
G4=TEXTJOIN(", ";TRUE;OFFSET($A$1;20*(ROW()-3);0;-20;1))

 

[ngocthach90]

Thử code này coi đúng ý không?

Sub ABC()
    Dim i&, iR&, Res(), k&
    With Sheets("Sheet1")
        iR = .Range("A" & Rows.Count).End(3).Row
        ReDim Res(1 To Int((iR - 1) / 20) + 1, 1 To 1)
        For i = 2 To iR Step 20
            k = k + 1
            Res(k, 1) = WorksheetFunction.TextJoin(",", True, .Cells(i, 1).Resize(20))
        Next
        .Range("G4").Resize(k, 1).Value = Res
    End With
End Sub

Code chạy tốt từ 2016 trở lên mà em đang dùng Excel 2010 nên code này ko xài được. Có cách nào khác không ạ?

 

[cantl]

Code chạy tốt từ 2016 trở lên mà em đang dùng Excel 2010 nên code này ko xài được. Có cách nào khác không ạ?

Dùng hàm thôi. Còn dữ liệu nhiều thì nghiên cứu hàm join của vba vậy.

 

[BuiQuangThuan]

Code chạy tốt từ 2016 trở lên mà em đang dùng Excel 2010 nên code này ko xài được. Có cách nào khác không ạ?

Thu thêm cách này coi sao

Sub ABC()
    Dim i&, iR&, Res(), k&, sArr(), Tmp, ii&
    With Sheets("Sheet1")
        iR = .Range("A" & Rows.Count).End(3).Row
        sArr = .Range("A2:A" & iR).Value
        ReDim Res(1 To Int(UBound(sArr) / 20) + 1, 1 To 1)
        For i = 1 To UBound(sArr) Step 20
            k = k + 1
            For ii = i To i + 19
                If ii < UBound(sArr) Then
                    If Len(Tmp) Then Tmp = Tmp & "," & sArr(ii, 1) Else Tmp = sArr(ii, 1)
                End If
            Next
            Res(k, 1) = Tmp: Tmp = Empty
        Next
        .Range("G4").Resize(k, 1).Value = Res
    End With
End Sub

 

[ngocthach90]

Thu thêm cách này coi sao

Sub ABC()
    Dim i&, iR&, Res(), k&, sArr(), Tmp, ii&
    With Sheets("Sheet1")
        iR = .Range("A" & Rows.Count).End(3).Row
        sArr = .Range("A2:A" & iR).Value
        ReDim Res(1 To Int(UBound(sArr) / 20) + 1, 1 To 1)
        For i = 1 To UBound(sArr) Step 20
            k = k + 1
            For ii = i To i + 19
                If ii < UBound(sArr) Then
                    If Len(Tmp) Then Tmp = Tmp & "," & sArr(ii, 1) Else Tmp = sArr(ii, 1)
                End If
            Next
            Res(k, 1) = Tmp: Tmp = Empty
        Next
        .Range("G4").Resize(k, 1).Value = Res
    End With
End Sub

Em test thử thì <100 thì được nhưng trên 100 hoặc 1 dãy mã số khách hàng khác thì có dòng bị lỗi