Cần giúp viết Code nối các ô có số với nhau (Kết quả nối được đặt tại các ô trống) (1 người xem)

[hung2412]

Xin chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột B có các ô trống xen kẽ giữa các ô có số, ví dụ:
[TABLE="class: cms_table, width: 100"]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]1531[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]642[/TD]
[/TR]
[/TABLE]

=> Vấn đề được đặt ra ở đây là: Làm thế nào để nối các ô có số với nhau giữa các ô trống (Kết quả nối được đặt tại các ô trống) (Các ô nối với nhau được ngăn cách bởi dấu phẩy). Ví dụ sau khi nối:

[TABLE="class: cms_table, width: 150"]
[TR]
[TD="align: center"]152, 133111[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]152, 1531, 133111[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]1531[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]642[/TD]
[/TR]
[TR]
[TD="align: center"]642[/TD]
[/TR]
[/TABLE]
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

 

[mhung12005]

Xin chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột B có các ô trống xen kẽ giữa các ô có số, ví dụ:

[TABLE="width: 100"]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]1531[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]Ô trống[/TD]
[/TR]
[TR]
[TD="align: center"]642[/TD]
[/TR]
[/TABLE]
=> Vấn đề được đặt ra ở đây là: Làm thế nào để nối các ô có số với nhau giữa các ô trống (Kết quả nối được đặt tại các ô trống) (Các ô nối với nhau được ngăn cách bởi dấu phẩy). Ví dụ sau khi nối:

[TABLE="width: 150"]
[TR]
[TD="align: center"]152, 133111[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]152, 1531, 133111[/TD]
[/TR]
[TR]
[TD="align: center"]152[/TD]
[/TR]
[TR]
[TD="align: center"]1531[/TD]
[/TR]
[TR]
[TD="align: center"]133111[/TD]
[/TR]
[TR]
[TD="align: center"]642[/TD]
[/TR]
[TR]
[TD="align: center"]642[/TD]
[/TR]
[/TABLE]
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Bạn thử sub này xem.

Sub test()    
    Dim SrcArr, ResArr()
    Dim lR As Long, lLastRow As Long
    Dim sTmp As String
    
    lLastRow = Sheet1.Range("B65000").End(xlUp).Row
    If lLastRow > 3 Then
        With Sheet1
            SrcArr = .Range("B3:B" & lLastRow).Value2
            ReDim ResArr(1 To UBound(SrcArr, 1), 1 To 1)
            For lR = UBound(SrcArr, 1) To 1 Step -1
                If Len(SrcArr(lR, 1)) Then
                    ResArr(lR, 1) = SrcArr(lR, 1)
                    sTmp = CStr(SrcArr(lR, 1)) & ", " & sTmp
                Else
                    ResArr(lR, 1) = Left(sTmp, Len(sTmp) - 2)
                    sTmp = ""
                End If
            Next lR
            .Range("E3:E1000").ClearContents
            .Range("E3").Resize(UBound(SrcArr, 1)).Value = ResArr
        End With
    End If
    
End Sub

 

[Quang_Hải]

Giải thuật giống bài 2 nhưng giảm bớt nhân sự

Sub QuangHai()
Dim Arr(), i, Tem
Arr = Range("B3", [B65536].End(3)).Value
For i = UBound(Arr) To 1 Step -1
   If Arr(i, 1) = "" Then
      Arr(i, 1) = Left(Tem, Len(Tem) - 2)
      Tem = Empty
   Else
      Tem = Arr(i, 1) & ", " & Tem
   End If
Next
[F3].Resize(UBound(Arr)) = Arr
End Sub

 

[hung2412]

Nhờ các bạn chỉ giáo mà tôi viết được Code cùi:
[GPECODE=vb]Sub NoiO()
Dim rng As Range
Dim i As Long
For Each rng In Range([B3], [B65536].End(xlUp)).SpecialCells(xlCellTypeBlanks)
If rng.Offset(2, 0) = "" Then
rng.Value = rng.Offset(1, 0).Value
Else
For i = rng.Offset(1, 0).Row To rng.Offset(1, 0).End(xlDown).Row
If Cells(i - 1, 1) = "" Then
Cells(i, 1) = "=RC2"
Else
Cells(i, 1) = "=R[-1]C& "", "" &RC2"
End If
Next
rng = Cells(i - 1, 1)
End If
Next
[A:A].Clear
End Sub
[/GPECODE]

 

[hung2412]

Nhờ các bạn chỉ giáo mà tôi viết được Code cùi:
[GPECODE=vb]Sub Noi_o_tren()
Dim Tam
Dim i As Long
For i = [B65536].End(xlUp).Row To 3 Step -1
If Cells(i, 2) <> "" Then
Tam = Cells(i, 2) & ", " & Tam
Else
Cells(i, 2) = Left(Tam, Len(Tam) - 2)
Tam = Empty
End If
Next
End Sub[/GPECODE]
Note: Ở đây tôi không khoe khoang gì cả (Tôi sẽ lưu Đề tài này dưới dạng Off), chỉ là tôi muốn cuối mỗi đề tài của tôi tổng kết lại Code để tiện cho việc lần sau tôi vào lấy thông tin thì không phải lọc lại từ đầu. Trân thành cảm ơn tất cả.