Nhờ anh chị giúp nối các dòng chuỗi trong excel thành 1 dòng bằng VBA hoặc công thức

[CHAOQUAY]

Anh CHAOQUAY ơi, tại lệnh này

With Sheet1.Range("A132").Resize(k, 1)
.Clear

Chỗ nó không xóa h dữ liệu trước đó. Anh có thể bổ dung em câu lệnh chỗ nãy, mỗi lần nối xóa dữ liệu cũ, rồi dán lại dữ liệu mới được không anh? cảm ơn anh!

Bạn sửa lại như bên dưới là được.

'With Sheet1.Range("A132").Resize(k, 1)
'    .Clear
'    .Value = Kq
'    .Interior.ThemeColor = xlThemeColorAccent6
'End With
Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Clear
Sheet1.Range("A2", "A" & k) = Kq

Có lẽ tốt nhất là tạo sheet mới rồi điền kết quả vào đó, phòng trường hợp muốn thay đổi điều kiện đầu vào thì còn có dữ liệu gốc để mà chạy. Cái này tùy bạn.

 

[phanmauthanh050]

Bạn sửa lại như bên dưới là được.

'With Sheet1.Range("A132").Resize(k, 1)
'    .Clear
'    .Value = Kq
'    .Interior.ThemeColor = xlThemeColorAccent6
'End With
Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Clear
Sheet1.Range("A2", "A" & k) = Kq

Có lẽ tốt nhất là tạo sheet mới rồi điền kết quả vào đó, phòng trường hợp muốn thay đổi điều kiện đầu vào thì còn có dữ liệu gốc để mà chạy. Cái này tùy bạn.

Em làm được rồi nè anh! Code anh đọc dễ hiểu và em đã edit. Đa tạ anh nhiều nhé!

Sub Gom_dong()
Dim Nguon
Dim Kq
Dim i, j, k
Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
ReDim Kq(1 To UBound(Nguon), 1 To 1)
With CreateObject("Scripting.Dictionary")
.Add "0500", ""
.Add "0620", ""
.Add "0700", ""
.Add "4600", ""
.Add "0600", ""
k = 0
For i = 1 To UBound(Nguon)
j = Left(Nguon(i, 1), 4)
If .exists(j) Then
k = k + 1
Kq(k, 1) = Nguon(i, 1)
Else
Kq(k, 1) = Kq(k, 1) & " &" & Nguon(i, 1)
End If
Next i
End With
Range("A:A").ClearContents
With Sheet2.Range("A2").Resize(k, 1)
.Clear
.Value = Kq
.Interior.ThemeColor = xlThemeColorAccent6
End With
End Sub