[Help] Nối các nội dung trong vùng dữ liệu thành 1 hàng (1 người xem)

[Song Huong]

Cám ơn bạn nhiều lắm luôn Cho mình hỏi nốt cái này là chạy macro là chạy như thế nào bạn (office 2013). Mình gà mong chỉ giáo

Bấm Alt+F8.
Run Macro NoiChuoi

 

[vuhungcute]

Bấm Alt+F8.
Run Macro NoiChuoi

Rồi làm sao để mình xuất cái đó ra bạn

 

[Song Huong]

Rồi làm sao để mình xuất cái đó ra bạn[/QUOTE

 

[vuhungcute]

Rồi làm sao để mình xuất cái đó ra bạn[/QUOTE

View attachment 133375

Cái của bạn là nó dính hoàn toàn các nội dung. Nó ko hoàn toàn tách các giá trị đó ra -_-

 

[Hai Lúa Miền Tây]

Chép code sau vào module file của bạn:

Function MergeRanges(ParamArray arguments() As Variant) As Variant()
    Dim cell As Range, temp() As Variant
    ReDim temp(0)
    For Each argument In arguments
      For Each cell In argument
        If cell <> "" Then
          temp(UBound(temp)) = cell
          ReDim Preserve temp(UBound(temp) + 1)
        End If
      Next cell
    Next argument
    ReDim Preserve temp(UBound(temp) - 1)
    MergeRanges = temp
End Function

Rồi chạy thủ tục sau:

Sub Gop()
    Dim iRow As Long, iRun As Long, rng As Range
    iRow = 104
    Sheet2.Cells.ClearContents
    For iRun = 0 To 30588
        Set rng = Sheet1.Range("A" & iRow & ":G" & iRow + 14)
        Sheet2.Cells(Sheet2.[A65536].End(3).Offset(1).Row, 1).Resize _
                    (1, UBound(MergeRanges(rng))).Value = MergeRanges(rng)
        iRow = iRow + 15
    Next
    Sheet2.Select
 
End Sub

 

[vuhungcute]

Chép code sau vào module file của bạn:

Function MergeRanges(ParamArray arguments() As Variant) As Variant()
    Dim cell As Range, temp() As Variant
    ReDim temp(0)
    For Each argument In arguments
      For Each cell In argument
        If cell <> "" Then
          temp(UBound(temp)) = cell
          ReDim Preserve temp(UBound(temp) + 1)
        End If
      Next cell
    Next argument
    ReDim Preserve temp(UBound(temp) - 1)
    MergeRanges = temp
End Function

Rồi chạy thủ tục sau:

Sub Gop()
    Dim iRow As Long, iRun As Long, rng As Range
    iRow = 104
    Sheet2.Cells.ClearContents
    For iRun = 0 To 30588
        Set rng = Sheet1.Range("A" & iRow & ":G" & iRow + 14)
        Sheet2.Cells(Sheet2.[A65536].End(3).Offset(1).Row, 1).Resize _
                    (1, UBound(MergeRanges(rng))).Value = MergeRanges(rng)
        iRow = iRow + 15
    Next
    Sheet2.Select
 
End Sub

Xin lỗi vì làm phiền bạn. THiệt tình là mình ko rành về cái fần macro này nên mình không biết làm như thế nào cả. Bạn chỉ chi tiết giúp mình với

 

[Hai Lúa Miền Tây]

Xin lỗi vì làm phiền bạn. THiệt tình là mình ko rành về cái fần macro này nên mình không biết làm như thế nào cả. Bạn chỉ chi tiết giúp mình với

Tôi làm luôn cho bạn, nhớ Enable macro trước khi chạy nhé.

Click Vào Đây Để Tải File

 

[vuhungcute]

Tôi làm luôn cho bạn, nhớ Enable macro trước khi chạy nhé.

Click Vào Đây Để Tải File

Thanks bạn nhiều lắm. Vậy là số cuối cùng là ko có phải ko bạn. Mình sẽ thêm tay số này vào ^^

 

[Hai Lúa Miền Tây]

Thanks bạn nhiều lắm. Vậy là số cuối cùng là ko có phải ko bạn. Mình sẽ thêm tay số này vào ^^

Chỉ có 1 số duy nhất thôi, còn lại sẽ lấy hết mà bạn. Số này tôi nghĩ bạn thừa sức để xử đúng không?

 

[vuhungcute]

Chỉ có 1 số duy nhất thôi, còn lại sẽ lấy hết mà bạn. Số này tôi nghĩ bạn thừa sức để xử đúng không?

Để mình cố -_- có 30K dòng thui Bạn ở đâu cho mình mời bạn 1 chầu cafe đc hem ^^

 

[Hai Lúa Miền Tây]

Để mình cố -_- có 30K dòng thui Bạn ở đâu cho mình mời bạn 1 chầu cafe đc hem ^^

Nói túm lại nó sẽ lấy hết số đó bạn, chỉ có 1 số duy nhất ở dòng cuối cùng nó nằm riêng lẻ thôi. Để xử cái này thì bạn tự làm nhé.