Cách ghép các chuỗi có số dòng bất kì

Liên hệ QC

tieulongphi

Thành viên mới
Tham gia
25/9/07
Bài viết
8
Được thích
3
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é.)
 

File đính kèm

  • caudovietnam.xls
    28 KB · Đọc: 25
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:

Mã:
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
 
Web KT
Back
Top Bottom