Ghép chuỗi lần lượt từng cell ở từng cột

hadoan-pap · 15/12/20

Em chào mọi người!

Em có vùng dữ lieu từ A:E như file đính kèm ạ.

Em muốn ghép lần lượt nội dung từng cell từ trái qua phải , ghép hết cell ở cột E thì sẽ ghép tiếp các cell ở cột D...cứ thế đến hết ạ.

Rất mong mọi người hỗ trợ ạ.

Em xin cảm ơn!

Ba Tê · 15/12/20

hadoan-pap đã viết:
Em chào mọi người!

Em có vùng dữ lieu từ A:E như file đính kèm ạ.

Em muốn ghép lần lượt nội dung từng cell từ trái qua phải , ghép hết cell ở cột E thì sẽ ghép tiếp các cell ở cột D...cứ thế đến hết ạ.

Rất mong mọi người hỗ trợ ạ.

Em xin cảm ơn!

Nhìn bằng mắt thì chuỗi cuối cùng ghép được là gì? "AC9", "AC369" hay chỉ có "9" ?

hadoan-pap · 15/12/20

Ba Tê đã viết:
Nhìn bằng mắt thì chuỗi cuối cùng ghép được là gì? "AC9", "AC369" hay chỉ có "9" ?

Dạ, AC369 ạ.

Tức là cứ cột nào còn dữ lieu ( tính từ cột trái sang phải ) là sẽ được lấy ra để ghép ạ.

Như hình đính kèm nếu cột A phát sinh them dữ lieu mới thì dữ lieu cuối sẽ là *C369 ạ

bomberman211 · 15/12/20

hadoan-pap đã viết:
Dạ, AC369 ạ.

Tức là cứ cột nào còn dữ lieu ( tính từ cột trái sang phải ) là sẽ được lấy ra để ghép ạ.

Như hình đính kèm nếu cột A phát sinh them dữ lieu mới thì dữ lieu cuối sẽ là *C369 ạ

Mình không hiểu qui luật lắm, ô E4 rỗng thì vẫn ghép, nếu ghép tất cả các ô rỗng luôn thì chuỗi cuối phải là 9 chứ nhỉ?

Nhattanktnn · 15/12/20

bomberman211 đã viết:
Mình không hiểu qui luật lắm, ô E4 rỗng thì vẫn ghép, nếu ghép tất cả các ô rỗng luôn thì chuỗi cuối phải là 9 chứ nhỉ?

Rỗng nhưng chắc không phải rỗng cuối cùng, có nghĩa là cứ ghép khi nào dưới nó không còn gì nữa.

hadoan-pap · 15/12/20

Nhattanktnn đã viết:
Rỗng nhưng chắc không phải rỗng cuối cùng, có nghĩa là cứ ghép khi nào dưới nó không còn gì nữa.

Đúng đấy ạ, cứ ghep đến khi nào dưới nó không còn dữ lieu ạ

befaint · 15/12/20

hadoan-pap đã viết:
Em có vùng dữ lieu từ A:E như file đính kèm ạ.

Em muốn ghép lần lượt nội dung từng cell từ trái qua phải , ghép hết cell ở cột E thì sẽ ghép tiếp các cell ở cột D...cứ thế đến hết ạ.

Có nhiêu đó thôi, hay còn dài dài nữa?

bomberman211 · 15/12/20

hadoan-pap đã viết:
Đúng đấy ạ, cứ ghep đến khi nào dưới nó không còn dữ lieu ạ

Ban thử code này xem:

PHP:

Sub Ghep_Chuoi()
Dim a As Long, b As Long, c As Long, d As Long, e As Long, r As Long, i As Long
Dim ar(5) As Long
    For i = 1 To 5
        ar(i) = Cells(65536, i).End(xlUp).Row
    Next
    r = 3
    For a = 3 To ar(1)
        For b = 3 To ar(2)
            For c = 3 To ar(3)
                For d = 3 To ar(4)
                    For e = 3 To ar(5)
                        Cells(r, 6) = Trim(Cells(a, 1) & " " & Cells(b, 2) & " " & Cells(c, 3) & " " & Cells(d, 4) & " " & Cells(e, 5))
                        r = r + 1
                    Next
                Next
            Next
        Next
    Next
End Sub

hadoan-pap · 15/12/20

befaint đã viết:
Có nhiêu đó thôi, hay còn dài dài nữa?

View attachment 251228

Dạ anh.

Dữ lieu nó biến động ạ... cứ dòng nào còn dữ lieu là nó tiếp tục ghép ạ.

Ví dụ e them dữ lieu vào ô A4 thi nó lại tiếp tục chạy ạ

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

bomberman211 đã viết:

Ban thử code này xem:

PHP:

Sub Ghep_Chuoi()
Dim a As Long, b As Long, c As Long, d As Long, e As Long, r As Long, i As Long
Dim ar(5) As Long
    For i = 1 To 5
        ar(i) = Cells(65536, i).End(xlUp).Row
    Next
    r = 3
    For a = 3 To ar(1)
        For b = 3 To ar(2)
            For c = 3 To ar(3)
                For d = 3 To ar(4)
                    For e = 3 To ar(5)
                        Cells(r, 6) = Trim(Cells(a, 1) & " " & Cells(b, 2) & " " & Cells(c, 3) & " " & Cells(d, 4) & " " & Cells(e, 5))
                        r = r + 1
                    Next
                Next
            Next
        Next
    Next
End Sub

Cảm ơn anh nhiều nhé.. Code này đúng rồi ạ ^^

HieuCD · 15/12/20

hadoan-pap đã viết:
Dạ anh.
Dữ lieu nó biến động ạ... cứ dòng nào còn dữ lieu là nó tiếp tục ghép ạ.
Ví dụ e them dữ lieu vào ô A4 thi nó lại tiếp tục chạy ạ

Ý là có thêm dòng hay cột không? Ví dụ 9 cột 9 dòng

hadoan-pap · 15/12/20

HieuCD đã viết:
Ý là có thêm dòng hay cột không? Ví dụ 9 cột 9 dòng

Dạ chỉ them dòng thôi ạ

HieuCD · 15/12/20

hadoan-pap đã viết:
Dạ chỉ them dòng thôi ạ

Nếu thêm cột, code sẽ rối

bomberman211 · 15/12/20

HieuCD đã viết:
Nếu thêm cột, code sẽ rối

Rối thiệt, nào rảnh rỗi mình nghĩ cách làm với số cột chưa biết trước thử xem

excel_lv1.5 · 15/12/20

hadoan-pap đã viết:
Em chào mọi người!

Em có vùng dữ lieu từ A:E như file đính kèm ạ.

Em muốn ghép lần lượt nội dung từng cell từ trái qua phải , ghép hết cell ở cột E thì sẽ ghép tiếp các cell ở cột D...cứ thế đến hết ạ.

Rất mong mọi người hỗ trợ ạ.

Em xin cảm ơn!

Dữ liệu ít chạy code nay thử xem,

Mã:

Sub a()
Dim arr, arr_Res, i As Long, j As Long, nR As Long, nC As Long, n As Long
Dim str As String, str_res As String
arr = [a3:e6]
nR = UBound(arr): nC = UBound(arr, 2)
ReDim arr_Res(1 To nR ^ nC, 1 To 1)
For i = 1 To nR ^ nC
    str_res = ""
    For j = 1 To nC
        n = Int((i - 1) / nR ^ (nC - j)) + 1
        str = arr(((n - 1) Mod nR) + 1, j)
        str_res = str_res & " " & str
    Next
    arr_Res(i, 1) = Trim(str_res)
Next
[f3].Resize(nR ^ nC, 1) = arr_Res
End Sub

befaint · 15/12/20

Theo mình giải thuật:
- Ghép 2 cột cuối được 1 mảng kết quả.
- Xét mảng 3 cột đầu, ghép 3 cột đó lại, nếu tồn tại chuỗi độ dài > 0 thì ghép chúng lần lượt với cái phần tử của mảng làm được ở bước trước.

Ngô Hải Đăng · 15/12/20

Code tìm côt cuối cùng

PHP:

Function CotCuoi(iSheet As Worksheet) As Long
  With WorksheetFunction
    If .CountA(iSheet.Cells) = 0 Then Exit Function
    Dim xCotDau&, xCotCuoi&, xTrungTam&, rOCuoi As Range
    xCotDau = 1: xCotCuoi = iSheet.Columns.Count
    Set rOCuoi = iSheet.Cells(iSheet.Rows.Count, iSheet.Columns.Count)
    
    While (xCotDau < xCotCuoi)
      If .CountA(Range(iSheet.Cells(1, xCotCuoi), rOCuoi)) = 0 Then
        xCotCuoi = xCotCuoi - 1
      Else
        xCotDau = xCotCuoi
      End If
      xTrungTam = (xCotDau + xCotCuoi) / 2
      If .CountA(Range(iSheet.Cells(1, xTrungTam), rOCuoi)) = 0 Then
        xCotCuoi = xTrungTam
      Else
        xCotDau = xTrungTam
      End If
    Wend
  End With
  CotCuoi = xCotCuoi
End Function

Nhattanktnn · 15/12/20

Ngô Hải Đăng đã viết:

Code tìm côt cuối cùng

PHP:

Function CotCuoi(iSheet As Worksheet) As Long
  With WorksheetFunction
    If .CountA(iSheet.Cells) = 0 Then Exit Function
    Dim xCotDau&, xCotCuoi&, xTrungTam&, rOCuoi As Range
    xCotDau = 1: xCotCuoi = iSheet.Columns.Count
    Set rOCuoi = iSheet.Cells(iSheet.Rows.Count, iSheet.Columns.Count)
   
    While (xCotDau < xCotCuoi)
      If .CountA(Range(iSheet.Cells(1, xCotCuoi), rOCuoi)) = 0 Then
        xCotCuoi = xCotCuoi - 1
      Else
        xCotDau = xCotCuoi
      End If
      xTrungTam = (xCotDau + xCotCuoi) / 2
      If .CountA(Range(iSheet.Cells(1, xTrungTam), rOCuoi)) = 0 Then
        xCotCuoi = xTrungTam
      Else
        xCotDau = xTrungTam
      End If
    Wend
  End With
  CotCuoi = xCotCuoi
End Function

Code đó kết quả giống code này thì phải:

Mã:

Function CotCuoi(iSheet As Worksheet) As Long
CotCuoi = iSheet.Cells.Find("*", , xlValues, , , xlPrevious).Column
End Function

hadoan-pap · 15/12/20

Em cảm ơn tất cả mọi người ạ!

bomberman211 · 15/12/20

HieuCD đã viết:
Nếu thêm cột, code sẽ rối

Bác xem thử code này ổn không? Số cột ban đầu được nhập từ inputbox.

Mã:

Sub Ghep_Chuoi2()
Dim nc As Long, j As Long, r As Long, i As Long
Dim ar() As Long
Dim max() As Long
Dim str As String
nc = InputBox("Nhap so cot:")
ReDim ar(nc) As Long
ReDim max(nc) As Long
    For i = 1 To nc
        max(i) = Cells(65536, i).End(xlUp).Row
        ar(i) = 3
    Next
    r = 3
    Do While i > 0
        str = ""
        For j = 1 To nc
            str = str & " " & Cells(ar(j), j)
        Next
        Cells(r, nc + 1) = Application.WorksheetFunction.Trim(str)
        r = r + 1
        If ar(nc) = max(nc) Then
            i = nc
            Do Until ar(i) < max(i) Or i = 0
                ar(i) = 3
                i = i - 1
            Loop
            ar(i) = ar(i) + 1
            ar(nc) = 2
        End If
        ar(nc) = ar(nc) + 1
    Loop
End Sub

Ngô Hải Đăng · 15/12/20

Nhattanktnn đã viết:
Code đó kết quả giống code này thì phải:

Mã:

Function CotCuoi(iSheet As Worksheet) As Long CotCuoi = iSheet.Cells.Find("*", , xlValues, , , xlPrevious).Column End Function

hình như cột thì phải thêm cái xlByColumn thì nó mới đúng

Ghép chuỗi lần lượt từng cell ở từng cột

Thành viên tiêu biểu

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên tiêu biểu

File đính kèm

***

Thành viên gắn bó

Thành viên tiêu biểu

|||||||||||||

***

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

***

Thành viên tích cực

|||||||||||||

Thành viên hoạt động

Thành viên gắn bó

Thành viên tiêu biểu

***

Thành viên hoạt động