Giúp giải bài tập nối chuỗi (1 người xem)

[gghh]

Xin anh, em chỉ giúp bài tập nối chuỗi như file kèm theo. Cảm ơn

 

[gtri]

Xin anh, em chỉ giúp bài tập nối chuỗi như file kèm theo. Cảm ơn

Dùng tạm file đính kèm này xem sao
dán cái này vào sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.Range("B3", "G" & Sheet1.UsedRange.Rows.Count)) Is Nothing Then
Application.Run "Noi_Chuoi"
End If
End Sub

tạo module vba, dán cái này vào

Public Sub Noi_Chuoi()
Dim DL, kq(), r As Long, c As Long
DL = Sheet1.Range("A2", "H" & Sheet1.UsedRange.Rows.Count)
ReDim kq(1 To UBound(DL) - 1, 1 To 1)

For r = 2 To UBound(DL)
For c = 2 To UBound(DL, 2) - 1
If UCase(DL(r, c)) = "X" Then
kq(r - 1, 1) = kq(r - 1, 1) & ", " & DL(1, c)
End If
Next c
kq(r - 1, 1) = Replace(" " & kq(r - 1, 1), " " & Left(kq(r - 1, 1), 2), "")
Next r

Sheet1.Range("H3", "H" & Sheet1.UsedRange.Rows.Count).Clear
Sheet1.Range("H3").Resize(UBound(kq), 1).Value = kq

End Sub

 

[comet_1701]

Dùng tạm file đính kèm này xem sao
dán cái này vào sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.Range("B3", "G" & Sheet1.UsedRange.Rows.Count)) Is Nothing Then
Application.Run "Noi_Chuoi"
End If
End Sub

tạo module vba, dán cái này vào

Public Sub Noi_Chuoi()
Dim DL, kq(), r As Long, c As Long
DL = Sheet1.Range("A2", "H" & Sheet1.UsedRange.Rows.Count)
ReDim kq(1 To UBound(DL) - 1, 1 To 1)

For r = 2 To UBound(DL)
For c = 2 To UBound(DL, 2) - 1
If UCase(DL(r, c)) = "X" Then
kq(r - 1, 1) = kq(r - 1, 1) & ", " & DL(1, c)
End If
Next c
kq(r - 1, 1) = Replace(" " & kq(r - 1, 1), " " & Left(kq(r - 1, 1), 2), "")
Next r

Sheet1.Range("H3", "H" & Sheet1.UsedRange.Rows.Count).Clear
Sheet1.Range("H3").Resize(UBound(kq), 1).Value = kq

End Sub

Sheet1.Range("H3", "H" & Sheet1.UsedRange.Rows.Count).Clear

đoạn nó nên thành

Sheet1.Range("H3", "H" & Sheet1.UsedRange.Rows.Count).Clearcontents

thì đỡ mất format cột H anh nhẩy

 

[gtri]

Gửi lại bạn file đính kèm
---
Bài trước bị thiếu

 

[gtri]

Sheet1.Range("H3", "H" & Sheet1.UsedRange.Rows.Count).Clear

đoạn nó nên thành

Sheet1.Range("H3", "H" & Sheet1.UsedRange.Rows.Count).Clearcontents

thì đỡ mất format cột H anh nhẩy

Ok.
đúng là khi viết code có hơi bị máy móc.
Thanks!

 

[gghh]

xim cảm ơn mọi người!