Giúp em gộp các ô thành 1 chuỗi

[nginh]

Đã hiệu chỉnh ở bài #29

 

[hoangson8768]

Em có 1 dãy số hóa đơn ở cột A và em phải làm tay thành kết quả ở ô B3
Các thầy giúp em dùng lệnh hay code vba như thế nào để được kết quả đó không ạ, em làm tay đau hết măt

Em gửi lại file chi tiết hơn để các bác hiểu rõ hơn giúp em, thanks

 

[ndu96081631]

Em gửi lại file chi tiết hơn để các bác hiểu rõ hơn giúp em, thanks

Biết ngay là phải có gì đó khác biết so với file ở bài đầu rồi
Tôi đang mường tượng: Làm xong hàm rồi cũng không biết sẽ kéo fill thể nào nữa?
Đâu có đơn giản!

 

[hoangson8768]

Biết ngay là phải có gì đó khác biết so với file ở bài đầu rồi
Tôi đang mường tượng: Làm xong hàm rồi cũng không biết sẽ kéo fill thể nào nữa?
Đâu có đơn giản!

Em gửi thầy bản cực kỳ chi tiết hơn và đúng gốc nó luôn ạ. thày giúp em với

 

[hoangson8768]

Kết quả không cần để ở ô Merge đâu ạ

 

[ndu96081631]

Em gửi thầy bản cực kỳ chi tiết hơn và đúng gốc nó luôn ạ. thày giúp em với

OK! Để tôi nghiên cứu xem nhưng không chắc là làm được!
Đây là bài khó nhai chứ chẳng chơi. Các cao thủ khác cũng thử xem nhé!

 

[Vu Dinh Duy]

Gửi bạn hoangson8768,
Mình đã cải tiến code của mình thêm một bước nữa.
________________________________________
Function combine(a As Range) As String
Dim kq As String, k As Long, kq1 As Long, i As Long, z As Long
kq = Cells(a.Row, a.Column)
kq1 = 100
For z = a.Row + 1 To a.Rows.Count + a.Row - 1
For i = 1 To Len(Cells(z, a.Column))
If Left(Cells(z - 1, a.Column), i) = Left(Cells(z, a.Column), i) Then
j = j + 1
End If
Next i
kq1 = WorksheetFunction.Min(j, kq1)
j = 0
Next z
For k = a.Row + 1 To a.Rows.Count + a.Row - 1
If Cells(k, a.Column) <> "" And WorksheetFunction.CountIf(Range(Cells(a.Row, a.Column), Cells(k, a.Column)), Cells(k, a.Column)) = 1 Then
kq = kq & "/" & Mid(Cells(k, a.Column), kq1 + 1, Len(Cells(k, a.Column)) - kq1)
End If
Next k
combine = kq
End Function
_________________________________
Với code này bạn nhập công thức vào ô B3 như sau: "=Combine(A3:A12)". Bạn nhớ chỉ chọn vừa đủ vùng cần nối thôi nhé. Vì nếu có ô trống thì kết quả không đúng nữa (Vẫn còn hạn chế này). Nếu có chuỗi giống nhau thì hàm này cũng chỉ lấy chuỗi xuất hiện lần thư nhất thôi.
Nếu theo file bạn mới gửi thì bạn phải lập lại hàm cho từng khối "Van DON" nhé.
Bạn tham khảo nhé.

 

[VetMini]

Bài toán đã rắc rối mà bạn còn dùng merged cells cho nên thêm rắm chuyện.

Giải thuật:
1. Đọc cột B theo từng khối "Van Don" (tra giá trị "Van DON" bên cột A để biết khi bắt đầu và kết thúc một khối). Nhét các trị "Cac so Invoices" vào một ArrayList (hoặc một collection dạng nào đó, có thể sort được).
2. Sort ArrayList
3. So giá trị đầu và cuối của ArrayList. Cách so đơn giản: so sánh ký tự từ trái sang phải cho đến lúc khác nhau (khi nào hàm chạy tốt rồi thì tính chuyện tối ưu hoá sau)
4. Sau khi tìm được vị trí khác nhau rồi thì lập chuỗi kết quả như sau:
4.1. Khởi đầu chuõi bằng trị đầu tiên của ArrayList
4.2. Nối các trị còn lại trong ArrrayList vào, kể từ ký tự khác nhau.
5. Ghi chuỗi kết quả
6. Tiếp tục lại bườc 1.

=== bổ sung ===

Thực ra, cách ghép chuỗi của bạn chính nó đã sai từ đầu, điển hình:

Ở Van Don KGL10061311, chuỗi kết quả là 555559-1/10-2/11/12. Làm sao người đọc hiểu cái Invoice thứ 2 nó chính thức là 5555510-1 (5 số 5) hay là 555510-1 (4 số 5)

 

[nginh]

Em gửi thầy bản cực kỳ chi tiết hơn và đúng gốc nó luôn ạ. thày giúp em với

Bạn thử hàm sau

Function gop(r As Range) As String
Dim i, j, k As Integer, m, u, cell As Range
u = WorksheetFunction.CountA(r)
For k = 1 To UBound(r.Value)
    If r(k) <> "" Then If WorksheetFunction.Match(r(k), r, 0) = k Then _
        i = i + 1: gop = gop & "/" & r(k)
Next
        gop = Replace(gop, "/", "", 1, 1)
For i = Len(r(1)) To 1 Step -1
    m = Left(r(1), i)
    j = 0
    For Each cell In r
        If cell Like m & "*" Then j = j + 1
    Next
    If j = u Then gop = m & Replace(gop, m, ""): Exit For
Next
End Function

Bạn cần sort hoá đơn ở vùng dữ liệu nguồn theo thứ tự mong muốn

 

[huuthang_bd]

Thực ra, cách ghép chuỗi của bạn chính nó đã sai từ đầu, điển hình:

Ở Van Don KGL10061311, chuỗi kết quả là 555559-1/10-2/11/12. Làm sao người đọc hiểu cái Invoice thứ 2 nó chính thức là 5555510-1 (5 số 5) hay là 555510-1 (4 số 5)

Vậy nên chăng thể hiện kết quả dạng này: 55555(9-1/10-2/11/12)
Chờ ý kiến phản hồi của chủ topic

 

[hoangson8768]

Bạn thử hàm sau

Function gop(r As Range) As String
Dim i, j, k As Integer, m, u, cell As Range
u = WorksheetFunction.CountA(r)
For k = 1 To UBound(r.Value)
    If r(k) <> "" Then If WorksheetFunction.Match(r(k), r, 0) = k Then _
        i = i + 1: gop = gop & "/" & r(k)
Next
        gop = Replace(gop, "/", "", 1, 1)
For i = Len(r(1)) To 1 Step -1
    m = Left(r(1), i)
    j = 0
    For Each cell In r
        If cell Like m & "*" Then j = j + 1
    Next
    If j = u Then gop = m & Replace(gop, m, ""): Exit For
Next
End Function

Bạn cần sort hoá đơn ở vùng dữ liệu nguồn theo thứ tự mong muốn

em đang test thấy chuẩn luôn ạ, em xin đa tạ cảm ơn bác nhiều, có lỗi em lại phiền bác

 

[hoangson8768]

Vậy nên chăng thể hiện kết quả dạng này: 55555(9-1/10-2/11/12)
Chờ ý kiến phản hồi của chủ topic

hệ thống không cho () ạ

 

[huuthang_bd]

Bạn thử hàm sau

Function gop(r As Range) As String
Dim i, j, k As Integer, m, u, cell As Range
u = WorksheetFunction.CountA(r)
For k = 1 To UBound(r.Value)
    If r(k) <> "" Then If WorksheetFunction.Match(r(k), r, 0) = k Then _
        i = i + 1: gop = gop & "/" & r(k)
Next
        gop = Replace(gop, "/", "", 1, 1)
For i = Len(r(1)) To 1 Step -1
    m = Left(r(1), i)
    j = 0
    For Each cell In r
        If cell Like m & "*" Then j = j + 1
    Next
    If j = u Then gop = m & Replace(gop, m, ""): Exit For
Next
End Function

Bạn cần sort hoá đơn ở vùng dữ liệu nguồn theo thứ tự mong muốn

em đang test thấy chuẩn luôn ạ, em xin đa tạ cảm ơn bác nhiều, có lỗi em lại phiền bác

Xem code của bạn nginh tôi thấy có một vài lỗi về thuật toán nên bạn hãy cẩn thận khi sử dụng:
1. Ở vòng lặp For k đã xét điều kiện r(k) <> "" tức là cho phép dữ liệu có ô rỗng và khi gộp lại sẽ bỏ qua các ô rỗng nhưng ở vòng lặp For i lại dùng ô r(1) làm chuẩn để xét những ô khác. Nếu ô đầu tiên của vùng tham chiếu (r(1)) là một ô rỗng thì các số hóa đơn sẽ không được rút gọn.

2. Code xóa phần trùng của các Invoice (gọi là phần đầu, phần còn lại gọi là phần đuôi) bằng hàm Replace nên nếu phần đuôi có chứa chuỗi trùng với phần đầu thì cũng bị xóa mất. Ví dụ các số 301929, 302302, 302630 gộp lại sẽ ra kết quả 301929/22/26

Còn đây là code của tôi. Bạn có thể tham khảo.

Function Join(Rng As Range)
Dim Cll As Range, Tmp As String, C As Long
Join = "/"
For Each Cll In Rng
    If InStr(Join, "/" & Cll.Value & "/") = 0 And Cll.Value <> "" Then
        Join = Join & Cll.Value & "/"
        If Tmp = "" Then Tmp = Cll.Value: C = Len(Tmp)
        Do Until Cll.Value Like Left(Tmp, C) & "*"
            C = C - 1
        Loop
    End If
Next
Join = Replace(Replace(Left(Join, Len(Join) - 1), "/" & Left(Tmp, C), "/"), "/", Left(Tmp, C), 1, 1)
End Function

 

[VetMini]

hệ thống không cho () ạ

Với điều kiện gộp của bạn,
dãy số (1) = 1559 ; 15510 ; 15511 ; 15512 ; 15513 ; 15514
dãy số (2) = 1559 ; 1510 ; 1511 ; 1512 ; 1513 ; 1514

2 dãy số dữ liệu khác nhau nhưng cho kết quả giống nhau:
1559/10/11/12/13/14

Tóm lại, câu hỏi của tôi là: nhìn vào chuỗi đã gộp, làm thế nào để biết phần sau giống phần đầu tất cả bao nhiêu ký tự?

 

[nginh]

Xem code của bạn nginh tôi thấy có một vài lỗi về thuật toán nên bạn hãy cẩn thận khi sử dụng:
1. Ở vòng lặp For k đã xét điều kiện r(k) <> "" tức là cho phép dữ liệu có ô rỗng và khi gộp lại sẽ bỏ qua các ô rỗng nhưng ở vòng lặp For i lại dùng ô r(1) làm chuẩn để xét những ô khác. Nếu ô đầu tiên của vùng tham chiếu (r(1)) là một ô rỗng thì các số hóa đơn sẽ không được rút gọn.

2. Code xóa phần trùng của các Invoice (gọi là phần đầu, phần còn lại gọi là phần đuôi) bằng hàm Replace nên nếu phần đuôi có chứa chuỗi trùng với phần đầu thì cũng bị xóa mất. Ví dụ các số 301929, 302302, 302630 gộp lại sẽ ra kết quả 301929/22/26

Bạn nói đúng, dưới đây là code đã hiệu chỉnh

Function gr(r As Range) As String
Dim cell As Range, i As Integer, u As Integer
For Each cell In r
    If Not gr Like "*" & cell & "*" Then gr = gr & "/" & cell: u = u + 1
Next
Do While gr <> "" And Len(gr) - Len(Replace(gr, Left(gr, i + 1), "/")) = i * u
    i = i + 1
Loop
    gr = Mid(gr, 2, i - 1) & Replace(Replace(gr, Left(gr, i), "/"), "/", "", 1, 1)
End Function

 

[huuthang_bd]

Bạn nói đúng, dưới đây là code đã hiệu chỉnh

Function gr(r As Range) As String
Dim cell As Range, i As Integer, u As Integer
For Each cell In r
    If Not gr Like "*" & cell & "*" Then gr = gr & "/" & cell: u = u + 1
Next
Do While gr <> "" And Len(gr) - Len(Replace(gr, Left(gr, i + 1), "/")) = i * u
    i = i + 1
Loop
    gr = Mid(gr, 2, i - 1) & Replace(Replace(gr, Left(gr, i), "/"), "/", "", 1, 1)
End Function

Khi kiểm tra bằng cách so sánh chuỗi (Instr, Like) cần chú ý đến trường hợp chuỗi trong chuỗi.
Như code của bạn, nếu gộp 196737 và 673 thì lại bị mất 673 kết quả chỉ còn 196737.

 

[hoangson8768]

Xem code của bạn nginh tôi thấy có một vài lỗi về thuật toán nên bạn hãy cẩn thận khi sử dụng:
1. Ở vòng lặp For k đã xét điều kiện r(k) <> "" tức là cho phép dữ liệu có ô rỗng và khi gộp lại sẽ bỏ qua các ô rỗng nhưng ở vòng lặp For i lại dùng ô r(1) làm chuẩn để xét những ô khác. Nếu ô đầu tiên của vùng tham chiếu (r(1)) là một ô rỗng thì các số hóa đơn sẽ không được rút gọn.

2. Code xóa phần trùng của các Invoice (gọi là phần đầu, phần còn lại gọi là phần đuôi) bằng hàm Replace nên nếu phần đuôi có chứa chuỗi trùng với phần đầu thì cũng bị xóa mất. Ví dụ các số 301929, 302302, 302630 gộp lại sẽ ra kết quả 301929/22/26

Còn đây là code của tôi. Bạn có thể tham khảo.

Function Join(Rng As Range)
Dim Cll As Range, Tmp As String, C As Long
Join = "/"
For Each Cll In Rng
    If InStr(Join, "/" & Cll.Value & "/") = 0 And Cll.Value <> "" Then
        Join = Join & Cll.Value & "/"
        If Tmp = "" Then Tmp = Cll.Value: C = Len(Tmp)
        Do Until Cll.Value Like Left(Tmp, C) & "*"
            C = C - 1
        Loop
    End If
Next
Join = Replace(Replace(Left(Join, Len(Join) - 1), "/" & Left(Tmp, C), "/"), "/", Left(Tmp, C), 1, 1)
End Function

thanks bác, em đang sử dụng code của bác thấy rất đúng

 

[nginh]

Khi kiểm tra bằng cách so sánh chuỗi (Instr, Like) cần chú ý đến trường hợp chuỗi trong chuỗi.
Như code của bạn, nếu gộp 196737 và 673 thì lại bị mất 673 kết quả chỉ còn 196737.

Bạn lại nói đúng nữa rồi . Tuy nhiên code của bạn cũng bị dính lỗi này, ví dụ : Join (196737,19673,1967,196,19,1) thì kết quả là 196737/9673/967/96/9/
Dưới đây là code đã hiệu chỉnh lỗi như bạn nói

Function gr(r As Range) As String
Dim cell As Range, i As Integer, u As Integer
For Each cell In r
    If cell <> "" Then If Not gr & "/" Like "*/" & cell & "/*" Then If gr Like "*/" & cell & "*" _
    Then gr = "/" & cell & gr: u = u + 1 Else gr = gr & "/" & cell: u = u + 1
Next
Do While gr <> "" And Len(gr) - Len(Replace(gr, Left(gr, i + 1), "/")) = i * u
    i = i + 1
Loop
    gr = Mid(gr, 2, i - 1) & Replace(Replace(gr, Left(gr, i), "/"), "/", "", 1, 1)
End Function

Ví dụ : gr(196737,19673,1967,196,19,1)=1/9/96/967/9673/96737