Gộp nhiều dòng thành một dòng

[DOTEXCEL2010]

Anh chị hõ trợ em với, em có đính kèm file excel ví dụ. Anh chị xem hướng dẫn em xử lý nhanh với ah. làm thủ công lâu quá hu hu
Mô tả:
Ngày 27/12 nội dung ở cột B từ B2 cho đến B4 sẽ được gọ lại thành 1 dòng di nhất ở C2 là kết quả mong muốn.
Anh chị có hàm hay cách nào hay chỉ giúp em với để em xử lý nội dung nhanh với ah. Bình thường em làm tay lâu quá.
Cảm ơn chị nhiều.

 

[CHAOQUAY]

Anh chị hõ trợ em với, em có đính kèm file excel ví dụ. Anh chị xem hướng dẫn em xử lý nhanh với ah. làm thủ công lâu quá hu hu
Mô tả:
Ngày 27/12 nội dung ở cột B từ B2 cho đến B4 sẽ được gọ lại thành 1 dòng di nhất ở C2 là kết quả mong muốn.
Anh chị có hàm hay cách nào hay chỉ giúp em với để em xử lý nội dung nhanh với ah. Bình thường em làm tay lâu quá.
Cảm ơn chị nhiều.

Hàm thì còn tùy theo bản excel của bạn.
Nếu không dùng hàm thì có thể dùng code dưới đây

Sub ghepDong()
Dim nguon, tam, kq
Dim rws, i
With Sheets("1")
    nguon = .Range("A2", .Range("B2").End(xlDown))
    rws = UBound(nguon)
    ReDim kq(1 To rws, 1 To 1)
    For i = rws To 1 Step -1
        tam = nguon(i, 2) & " " & tam
        If nguon(i, 1) <> "" Then
            kq(i, 1) = Trim(tam)
            tam = ""
        End If
    Next i
    .Range("C2").Resize(rws, 1).ClearContents
    .Range("C2").Resize(rws, 1) = kq
End With
End Sub

 

[DOTEXCEL2010]

Hàm thì còn tùy theo bản excel của bạn.
Nếu không dùng hàm thì có thể dùng code dưới đây

Sub ghepDong()
Dim nguon, tam, kq
Dim rws, i
With Sheets("1")
    nguon = .Range("A2", .Range("B2").End(xlDown))
    rws = UBound(nguon)
    ReDim kq(1 To rws, 1 To 1)
    For i = rws To 1 Step -1
        tam = nguon(i, 2) & " " & tam
        If nguon(i, 1) <> "" Then
            kq(i, 1) = Trim(tam)
            tam = ""
        End If
    Next i
    .Range("C2").Resize(rws, 1).ClearContents
    .Range("C2").Resize(rws, 1) = kq
End With
End Sub

Cảm ơn #CHAOQUAY rất nhiều. em đã thử và đúng như ý muốn rồi ah.

Bài đã được tự động gộp: 5/9/20

Hàm thì còn tùy theo bản excel của bạn.
Nếu không dùng hàm thì có thể dùng code dưới đây

Sub ghepDong()
Dim nguon, tam, kq
Dim rws, i
With Sheets("1")
    nguon = .Range("A2", .Range("B2").End(xlDown))
    rws = UBound(nguon)
    ReDim kq(1 To rws, 1 To 1)
    For i = rws To 1 Step -1
        tam = nguon(i, 2) & " " & tam
        If nguon(i, 1) <> "" Then
            kq(i, 1) = Trim(tam)
            tam = ""
        End If
    Next i
    .Range("C2").Resize(rws, 1).ClearContents
    .Range("C2").Resize(rws, 1) = kq
End With
End Sub

ah Anh, Mình có thể ghép xong rồi xóa đi các dòng trống luôn ko anh nhỉ.

 

[CHAOQUAY]

Cảm ơn #CHAOQUAY rất nhiều. em đã thử và đúng như ý muốn rồi ah.

Bài đã được tự động gộp: 5/9/20

ah Anh, Mình có thể ghép xong rồi xóa đi các dòng trống luôn ko anh nhỉ.

Xóa được bạn, kết quả sẽ hiển thị thế nào

 

[CHAOQUAY]

@DOTEXCEL2010
Bạn chạy code dưới đây

Sub ghepDong_()
Dim nguon, kq
Dim rws, i, k
With Sheets("1")
    nguon = .Range("A2", .Range("B2").End(xlDown))
    rws = UBound(nguon)
    ReDim kq(1 To rws, 1 To 1)
    For i = 1 To rws
        If nguon(i, 1) <> "" Then
            k = k + 1
            kq(k, 1) = nguon(i, 2)
        Else
            kq(k, 1) = kq(k, 1) & " " & nguon(i, 2)
        End If
    Next i
    .Range("C2").Resize(rws, 1).ClearContents
    .Range("C2").Resize(rws, 1) = kq
End With
End Sub

 

[DOTEXCEL2010]

@DOTEXCEL2010
Bạn chạy code dưới đây

Sub ghepDong_()
Dim nguon, kq
Dim rws, i, k
With Sheets("1")
    nguon = .Range("A2", .Range("B2").End(xlDown))
    rws = UBound(nguon)
    ReDim kq(1 To rws, 1 To 1)
    For i = 1 To rws
        If nguon(i, 1) <> "" Then
            k = k + 1
            kq(k, 1) = nguon(i, 2)
        Else
            kq(k, 1) = kq(k, 1) & " " & nguon(i, 2)
        End If
    Next i
    .Range("C2").Resize(rws, 1).ClearContents
    .Range("C2").Resize(rws, 1) = kq
End With
End Sub

Có rút gọn lên anh. Ý của em là xóa luôn dòng mình gộp lên rồi
Tức là em bấm theo cột ngày á anh. vì cột ngày chỉ có 1 dòng có dữ liệu. Như hùi sáng code là ok rồi mà chỉ cần xóa mấy dòng trống ngày ở cột A đó anh.

 

[CHAOQUAY]

Có rút gọn lên anh. Ý của em là xóa luôn dòng mình gộp lên rồi
Tức là em bấm theo cột ngày á anh. vì cột ngày chỉ có 1 dòng có dữ liệu. Như hùi sáng code là ok rồi mà chỉ cần xóa mấy dòng trống ngày ở cột A đó anh.

Tức là bạn muốn kết quả có 2 cột: STT & kết quả ghép?

 

[DOTEXCEL2010]

Dạ đúng rồi anh.

 

[CHAOQUAY]

Sub ghepDong_()
Dim nguon, kq
Dim rws, i, k
With Sheets("1")
    nguon = .Range("A2", .Range("B2").End(xlDown))
    rws = UBound(nguon)
    ReDim kq(1 To rws, 1 To 3)
    For i = 1 To rws
        If nguon(i, 1) <> "" Then
            k = k + 1
            kq(k, 1) = k
            kq(k, 2) = nguon(i, 1)
            kq(k, 3) = nguon(i, 2)
        Else
            kq(k, 3) = kq(k, 3) & " " & nguon(i, 2)
        End If
    Next i
    .Range("C2").Resize(rws, 3).ClearContents
    .Range("C2").Resize(rws, 3) = kq
End With
End Sub

 

[Phuocam]

Bói thử một quẻ:

Sub GhepVaXoaDong_()
Dim a
Dim lr As Long, i As Long, k As Long
With Sheets("1")
    lr = .Range("B" & .Rows.Count).End(xlUp).Row
    a = .Range("A2:B" & lr).Value
   
   
    For i = 1 To lr - 1
        If a(i, 1) <> "" Then
            k = k + 1
            a(k, 1) = a(i, 1)
            a(k, 2) = a(i, 2)
        Else
            a(k, 2) = a(k, 2) & " " & a(i, 2)
        End If
    Next i
    .Range("A2:B" & lr).ClearContents
    .Range("A2").Resize(k, 2) = a
End With
End Sub

Hahaha ...

 

[DOTEXCEL2010]

Bói thử một quẻ:

Sub GhepVaXoaDong_()
Dim a
Dim lr As Long, i As Long, k As Long
With Sheets("1")
    lr = .Range("B" & .Rows.Count).End(xlUp).Row
    a = .Range("A2:B" & lr).Value
  
  
    For i = 1 To lr - 1
        If a(i, 1) <> "" Then
            k = k + 1
            a(k, 1) = a(i, 1)
            a(k, 2) = a(i, 2)
        Else
            a(k, 2) = a(k, 2) & " " & a(i, 2)
        End If
    Next i
    .Range("A2:B" & lr).ClearContents
    .Range("A2").Resize(k, 2) = a
End With
End Sub

Hahaha ...

Em copy code dán vào rồi thì cũng ok ah. nhưng em mới thêm 2 cột No và Có ( là C và D) thì cột B không gộp dòng cuối cho em anh ợ. khắc phục như thế nào anh nhỉ. chỉ giúp em với.

 

[Phương Phương mito]

Sub ghepDong_()
Dim nguon, kq
Dim rws, i, k
With Sheets("1")
    nguon = .Range("A2", .Range("B2").End(xlDown))
    rws = UBound(nguon)
    ReDim kq(1 To rws, 1 To 3)
    For i = 1 To rws
        If nguon(i, 1) <> "" Then
            k = k + 1
            kq(k, 1) = k
            kq(k, 2) = nguon(i, 1)
            kq(k, 3) = nguon(i, 2)
        Else
            kq(k, 3) = kq(k, 3) & " " & nguon(i, 2)
        End If
    Next i
    .Range("C2").Resize(rws, 3).ClearContents
    .Range("C2").Resize(rws, 3) = kq
End With
End Sub

E có tìm hiểu về Arr mà đọc mãi em vẫn chưa hiểu nó nạp vào thế nào ạ. Em có bấm F8 đẻ xem kết quả chạy từng đoạn mà em chỉ thấy nó lấy Dòng ban đầu vào. A có thể cho em giải thích từng code không ạ

 

[CHAOQUAY]

E có tìm hiểu về Arr mà đọc mãi em vẫn chưa hiểu nó nạp vào thế nào ạ. Em có bấm F8 đẻ xem kết quả chạy từng đoạn mà em chỉ thấy nó lấy Dòng ban đầu vào. A có thể cho em giải thích từng code không ạ

Giải thích code hơi bị kém, có lẽ bạn thử thay đổi số liệu đầu vào rồi xem kết quả đầu ra xem có thêm được gì không.

 

[dangkhoiLK]

E có tìm hiểu về Arr mà đọc mãi em vẫn chưa hiểu nó nạp vào thế nào ạ. Em có bấm F8 đẻ xem kết quả chạy từng đoạn mà em chỉ thấy nó lấy Dòng ban đầu vào. A có thể cho em giải thích từng code không ạ

nguon = .Range("A2", .Range("B2").End(xlDown))
Nguon se bằng vùng A2 đến dòng cuối cùng của cột B
Vi du Range(A2:B5) trả về mã giá trị củ các ô từ A2 đến A5