Ghép chuỗi lần lượt từng cell ở từng cột

[hadoan-pap]

Em chào mọi người!

Em có vùng dữ lieu từ A:E như file đính kèm ạ.

Em muốn ghép lần lượt nội dung từng cell từ trái qua phải , ghép hết cell ở cột E thì sẽ ghép tiếp các cell ở cột D...cứ thế đến hết ạ.

Rất mong mọi người hỗ trợ ạ.

Em xin cảm ơn!

 

[HieuCD]

Bác xem thử code này ổn không? Số cột ban đầu được nhập từ inputbox.

Sub Ghep_Chuoi2()
Dim nc As Long, j As Long, r As Long, i As Long
Dim ar() As Long
Dim max() As Long
Dim str As String
nc = InputBox("Nhap so cot:")
ReDim ar(nc) As Long
ReDim max(nc) As Long
    For i = 1 To nc
        max(i) = Cells(65536, i).End(xlUp).Row
        ar(i) = 3
    Next
    r = 3
    Do While i > 0
        str = ""
        For j = 1 To nc
            str = str & " " & Cells(ar(j), j)
        Next
        Cells(r, nc + 1) = Application.WorksheetFunction.Trim(str)
        r = r + 1
        If ar(nc) = max(nc) Then
            i = nc
            Do Until ar(i) < max(i) Or i = 0
                ar(i) = 3
                i = i - 1
            Loop
            ar(i) = ar(i) + 1
            ar(nc) = 2
        End If
        ar(nc) = ar(nc) + 1
    Loop
End Sub

Giải thuật rất hay
Tốc độ code hạn chế do phải nhập số cột, gán kết quả vào Cell nhiều lần, và giống như bài #14 số lần xử lý ghép chuỗi lớn
str = ""
For j = 1 To nc
str = str & " " & Cells(ar(j), j)
Next
Theo hướng giải thuật của bạn @befaint ở bài #15 có số lần ghép chuỗi ít hơn nhiều lần

 

[Nhattanktnn]

hình như cột thì phải thêm cái xlByColumn thì nó mới đúng

Uh đúng rồi bạn, lúc viết nghĩ hơi ẩu nên thiếu