Cách ghép các chuỗi có số dòng bất kì (1 người xem)

[tieulongphi]

Mình có một bảng tính, yêu cầu trình bày các câu lại, nhờ cao thủ giúp đỡ nhé. Xin cám ơn nhiều
(Mình không biết trình bày sao cho rõ, các bạn xem file đính kèm giùm nhé.)

 

[VetMini]

Mình có một bảng tính, yêu cầu trình bày các câu lại, nhờ cao thủ giúp đỡ nhé. Xin cám ơn nhiều
(Mình không biết trình bày sao cho rõ, các bạn xem file đính kèm giùm nhé.)

Không biết trình bày cho rõ thì chịu khó học cách ăn nói nhã nhặn. Bày đặt tâng bốc cao thủ cao thẻo làm chi.

Hàm rất dài, và có thể phải qua công đoạn cột phụ hoặc named formula. Dùng code tiện hơn:

Sub ketqua()
Dim s As String
Dim c As Range, clst As Range
Dim akq() As Variant, lkq As Long

s = "L" & ChrW(224) & " c" & ChrW(225) & "i g" & ChrW(236) & "?"
With Sheets("bandau")
lkq = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim akq(1 To lkq, 1 To 2)
With .Range(.Cells(1, 1), .Cells(lkq, 1))
    Set c = .Find(s, LookIn:=xlValues)
    If Not c Is Nothing Then
        lkq = 0
        Set clst = .Cells(1, 1)
        Do
            lkq = lkq + 1
            akq(lkq, 1) = c.Offset(1, 0).Value
            akq(lkq, 2) = Join(Application.Transpose(Range(clst, c)), "\r\n")
            Set clst = c.Offset(2, 0)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Row > clst.Row
    End If
End With
End With
Sheets("ketqua").Range("A1").Resize(lkq, 2).Value = akq

Set shkq = Nothing
Set c = Nothing
Set clst = Nothing
End Sub