Nhờ giúp đỡ: VBA - tách dữ liệu số trong ô cell thành cột mà không dùng function split

[mira1225]

Chào cả nhà
Em đang gặp khó khi xử lý code VBA tạo chức năng split dữ liệu (như file đính kèm) mà trong quy định không được dùng function split...Em có tham khảo các mã code anh chị trên diễn đàn dùng trước đó đều có dùng split()
Nhờ cả nhà chỉ giáo giúp em có cách nào tách dữ liệu mà ko sài chức năng split() ko
Em cảm ơn nhiều

 

[Quang_Hải]

Rồi, rồi: Trúng mánh rồi 2uang Hải ơi! Xin chúc mừng chú mày nha.

Thật sự thì bài này dùng Reg thì cũng đơn giản thôi mà, nhưng có cần dùng cái đao to như thế không chứ. Dạo này em gác kiếm rồi bác Sa ơi. Lâu lâu chọt chọt tí cũng là để thông báo cho mọi người biết là mình vẫn còn đây, chưa bị chị Vy ăn thịt.

 

[mira1225]

Đã nhắc hai lần rồi. Chỉ cần chỉnh lại những chỗ viết tắt thôi.
Là người có khả năng ra công giúp, tôi tự cho mình có quyền đòi hỏi bên kia phải dùng tiếng Việt nghiêm chỉnh.
Viết tiếng Việt đầy đủ thì chỉ tăng cái nhìn văn hoá thôi chứ có giảm đâu mà phải lằng nhằng.
Nếu tôi là người cần học thì tôi thi gan thẳng với vấn đề, với code chứ cãi lý thì cuối cùng học được gì?

Ở đây là thái độ khi tôi thấy bạn đưa ra các comment ở trên. Sự giúp đỡ của "người có khả năng ra công giúp và có quyền đòi hỏi" bạn có thể giữ lại, tôi xin phép từ chối nhận.

 

[VetMini]

Thật sự thì bài này dùng Reg thì cũng đơn giản thôi mà, ...

Hồi nào giờ dân ở đây quen dùng hàm Replace của RegEx. Ít khi thấy dùng đến Match Array.

Nếu muốn thử thách thì thử duyệt chuỗi không qua vòng lặp.
Gợi ý: hầu hết các code vòng lặp đều có thể thay bằng đệ quy.

 

[HieuCD]

Chào cả nhà
Em đang gặp khó khi xử lý code VBA tạo chức năng split dữ liệu (như file đính kèm) mà trong quy định không được dùng function split...Em có tham khảo các mã code anh chị trên diễn đàn dùng trước đó đều có dùng split()
Nhờ cả nhà chỉ giáo giúp em có cách nào tách dữ liệu mà ko sài chức năng split() ko
Em cảm ơn nhiều

Chỉ dùng hàm ubound, mid và len

Sub ABC()
  Dim sArr(), Res(), sRow&, i&, N&, j&, k&, str$, tmp$, char$
  Const deli$ = ";"
 
  sArr = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 3)
  For i = 1 To sRow
    str = sArr(i, 1) & deli
    N = Len(str)
    tmp = Empty: k = 0
    For j = 1 To N
      char = Mid(str, j, 1)
      If char = deli Then
        k = k + 1
        If k > UBound(Res, 2) Then ReDim Preserve Res(1 To sRow, 1 To k)
        Res(i, k) = tmp
        tmp = Empty
      Else
        tmp = tmp & char
      End If
    Next j
  Next i
  Range("C1").CurrentRegion.ClearContents
  Range("C1").Resize(sRow, UBound(Res, 2)) = Res
End Sub

 

[mira1225]

Cảm ơn @HieuCD đã hỗ trợ rất nhiều, code chạy ok quá ạ. Cho em hỏi ngu xíu nếu mình không dùng hàm function của Excel khi viết code thì có giải pháp nào chạy ra được chức năng tách số này không ạ, em mong được chỉ giáo thêm

Chỉ dùng hàm ubound, mid và len

Sub ABC()
  Dim sArr(), Res(), sRow&, i&, N&, j&, k&, str$, tmp$, char$
  Const deli$ = ";"
 
  sArr = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 3)
  For i = 1 To sRow
    str = sArr(i, 1) & deli
    N = Len(str)
    tmp = Empty: k = 0
    For j = 1 To N
      char = Mid(str, j, 1)
      If char = deli Then
        k = k + 1
        If k > UBound(Res, 2) Then ReDim Preserve Res(1 To sRow, 1 To k)
        Res(i, k) = tmp
        tmp = Empty
      Else
        tmp = tmp & char
      End If
    Next j
  Next i
  Range("C1").CurrentRegion.ClearContents
  Range("C1").Resize(sRow, UBound(Res, 2)) = Res
End Sub

 

[batman1]

Trong ô A29 ở cuối có dấu cách Non-breaking space với mã là 160, phải xóa đi, vd. bằng tay hoặc bằng code.

Sub tach_chuoi()
Dim r As Long, c As Long, start As Long, k As Long, text As String, dulieu(), kq()
Const delim = ";"
  dulieu = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim kq(1 To UBound(dulieu), 1 To 3)
    For r = 1 To UBound(dulieu)
        text = dulieu(r, 1) & delim
        k = 0
        start = 1
        For c = 1 To Len(text)
            If Mid(text, c, 1) = delim Then
                k = k + 1
                If k > UBound(kq, 2) Then ReDim Preserve kq(1 To UBound(kq, 1), 1 To k)
                kq(r, k) = Mid(text, start, c - start)
                start = c + 1
            End If
        Next c
    Next r
    With Range("C1")
        .CurrentRegion.ClearContents
        .Resize(UBound(kq, 1), UBound(kq, 2)) = kq
    End With
End Sub

 

[Phuocam]

kq(r, k) = Mid(text, start, c - start)

Dùng hàm MID là phạm quy rồi anh ơi. Hahaha ...

.

 

[CHAOQUAY]

Cảm ơn @CHAOQUAY đã hỗ trợ, nhưng nếu không sử dụng Texttocolumns (ko dùng function trong excel) luôn thì có code vòng lặp nào chạy được ko ạ ?
Em cảm ơn

Bài đã được tự động gộp: 21/2/22

Cảm ơn bác @quang Hải đã hỗ trợ, nhưng nếu code ko dùng function excel luôn (như texttocolumns) luôn thì có cách nào khác không ạ ?
Xin cảm ơn

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

Option Explicit

Sub c_l_g_t()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 3)
For i = 1 To rws
    t = 0
    For j = 250000 To 350000
        x = 200 & ";" & j / 100000
        For k = 300000 To 450000
            z = x & ";" & k / 100000
            If z = Nguon(i, 1) Then
                Kq(i, 1) = 200
                Kq(i, 2) = j / 100000
                Kq(i, 3) = k / 100000
                
                t = 1
                Exit For
            End If
        Next k
        If t = 1 Then Exit For
    Next j
Next i
Sheet1.Range("C2").Resize(rws, 3) = Kq
End Sub

 

[huhumalu]

Đúng rồi, đã nói không cho dùng function

Dùng hàm MID là phạm quy rồi anh ơi. Hahaha ...

Thực ra vấn đề chung của các thanh niên, có rất nhiều cách làm, trong này cũng các anh gạo cội, nhưng sao nói hoài mà mấy ảnh không chịu ra tay.
Vì cách bạn hỏi và trình bày, nếu bạn biết code, sao bạn không đưa ra là bạn làm bị vấp chỗ nào, mà kiểu như quăng đề bài ra, rồi bảo làm đi...
Bạn vô tư hoặc không hiểu ra vấn đề mình mắc phải.
Nếu bạn muốn học thì có một vài cách sau:
+ Bạn đưa phần bạn làm giang dở, sẽ có người hỗ trợ hoàn thiện, từ đó đúc tỉa ra sai chỗ nào và học.
+ Bạn lên hỏi thuật toán nếu chưa biết phải làm gì, ngồi gõ, rồi quay lại bước trên.
----------------
Quay lại bài toán của bạn, bạn chỉ cần nói rõ là bạn chỉ muốn sử dụng vòng lặp cho bài toán này.
+ Vòng lặp có làm được không --> được
+ Không sử dụng hàm có sẵn, cái này vô chừng và giới hạn ra sao, len, mid, left, right ... những cái vô cùng thông dụng có được dùng kg ?
+ Giải thuật bạn có thể tham khảo:
# Bạn duyệt qua chuỗi đang xét, nếu bắt gặp dấu phân cách thì bạn đánh dấu lại, chuỗi sẽ nằm trong 2 dấu phân cách, điểm 1 và dấu phân cách đầu tiên, dấu phân cách cuối cùng và điểm kết thúc chuỗi.
# Bạn duyệt qua và dùng 2 biến (start, end) chẳng hạn, duyệt qua thì gặp dấu phân cách thì end biến thành vị trí duyệt.
# Nếu không cho dùng len, mid, left thì bạn cho duyệt qua 10.000 ký tự chẳng hạn, sau đó duyệt qua 1 ký tự thì bạn cũng đưa xuống trang tính, duyệt bao nhiêu đưa xuống cột bấy nhiêu, khi gặp dấu phân cách thì chuyển sang cột mới cho đến hết, hết thì chuyển sang dòng mới.

~~~~~~~~
Tiên học lễ, hậu học văn.

 

[VetMini]

...
+ Vòng lặp có làm được không --> được

Duyệt chuỗi căn bản là dùng vòng lặp. Cho nên câu này không thành vấn đề.

...
+ Giải thuật bạn có thể tham khảo:
# Bạn duyệt qua chuỗi đang xét, nếu bắt gặp dấu phân cách thì bạn đánh dấu lại, chuỗi sẽ nằm trong 2 dấu phân cách, điểm 1 và dấu phân cách đầu tiên, dấu phân cách cuối cùng và điểm kết thúc chuỗi.
# Bạn duyệt qua và dùng 2 biến (start, end) chẳng hạn, duyệt qua thì gặp dấu phân cách thì end biến thành vị trí duyệt.

Trong cụm từ VBA, B là ký tự viết tắt của BASIC (Beginner's All-purpose Symbolic Instruction Code)
BASIC vốn là ngôn ngữ coi chuỗi như một kiểu căn bản.
Nhưng khác với các loại kiểu căn bản như Integer, Long, Double,... chuỗi hơi phức tạp hơn cho nên BASIC bắt buộc phải thêm một số hàm để sử lý các con toán căn bản. Đó là đám hàm Len, Left, Right, MId...

...
# Nếu không cho dùng len, mid, left thì bạn cho duyệt qua 10.000 ký tự chẳng hạn, sau đó duyệt qua 1 ký tự thì bạn cũng đưa xuống trang tính, duyệt bao nhiêu đưa xuống cột bấy nhiêu, khi gặp dấu phân cách thì chuyển sang cột mới cho đến hết, hết thì chuyển sang dòng mới.

Duyệt chuỗi là đọc từng ký tự của chuỗi. Để có thể truy vấn ký tự của chuỗi, VBA bắt buộc phải dùng hàm MID. Và vì VBA không có quy luật về cách kết thúc chuỗi cho nên Len là cách duy nhất để biết độ dài chuỗi. Không có cách nào khác (*1)
Chỉ những ngôn ngữ có phép dời chuỗi, hoặc dùng con trỏ mới không phải dùng hàm Mid.

Các hàm giúp cho việc lập trình hiệu quả hơn như Split là hàm riêng của VBA, vốn không nằm trong nhóm hàm căn bản của BASIC.

(*1) Trừ phi bạn hiểu rõ về cấu trúc chuỗi, và dùng các thủ thuật đọc meta-data để đọc cái ô chứa tin tức về chuỗi. Ở GPE, có khoảng 3 hay 4 người đạt trình độ này.

 

[batman1]

Duyệt chuỗi căn bản là dùng vòng lặp. Cho nên câu này không thành vấn đề.
1 lần để

Câu hỏi mà tôi cho là quan trọng nhất đó là: cấm dùng các hàm của worksheet, của VBA để làm gì? Cách viết code không dùng bất cứ hàm nào sẽ là cách làm việc hàng ngày hay chỉ là diễn cho bồ lác mắt, hay là cách cho học sinh biết, ai đang có quyền thét ra lửa ở đây. Đúng là rỗi hơi bầy trò. Nếu muốn tập viết code thì thiếu gì bài tập tốt hơn rất nhiều.

 

[SA_DQ]

Coi chừng ăn gạch đá bây chừ!

 

[mira1225]

Cảm ơn @CHAOQUAY nhiều nhé

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

Option Explicit

Sub c_l_g_t()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 3)
For i = 1 To rws
    t = 0
    For j = 250000 To 350000
        x = 200 & ";" & j / 100000
        For k = 300000 To 450000
            z = x & ";" & k / 100000
            If z = Nguon(i, 1) Then
                Kq(i, 1) = 200
                Kq(i, 2) = j / 100000
                Kq(i, 3) = k / 100000
               
                t = 1
                Exit For
            End If
        Next k
        If t = 1 Then Exit For
    Next j
Next i
Sheet1.Range("C2").Resize(rws, 3) = Kq
End Sub

Bài đã được tự động gộp: 22/2/22

Cảm ơn @huhumalu đã hỗ trợ và góp ý, mình sẽ chú ý hơn khi hỏi bài sau này trên diễm đàn để anh chị em dễ hiểu hơn. Lần đầu gửi bài chắc chắn có sai sót, mong thông cảm nhé.

Đúng rồi, đã nói không cho dùng function

Thực ra vấn đề chung của các thanh niên, có rất nhiều cách làm, trong này cũng các anh gạo cội, nhưng sao nói hoài mà mấy ảnh không chịu ra tay.
Vì cách bạn hỏi và trình bày, nếu bạn biết code, sao bạn không đưa ra là bạn làm bị vấp chỗ nào, mà kiểu như quăng đề bài ra, rồi bảo làm đi...
Bạn vô tư hoặc không hiểu ra vấn đề mình mắc phải.
Nếu bạn muốn học thì có một vài cách sau:
+ Bạn đưa phần bạn làm giang dở, sẽ có người hỗ trợ hoàn thiện, từ đó đúc tỉa ra sai chỗ nào và học.
+ Bạn lên hỏi thuật toán nếu chưa biết phải làm gì, ngồi gõ, rồi quay lại bước trên.
----------------
Quay lại bài toán của bạn, bạn chỉ cần nói rõ là bạn chỉ muốn sử dụng vòng lặp cho bài toán này.
+ Vòng lặp có làm được không --> được
+ Không sử dụng hàm có sẵn, cái này vô chừng và giới hạn ra sao, len, mid, left, right ... những cái vô cùng thông dụng có được dùng kg ?
+ Giải thuật bạn có thể tham khảo:
# Bạn duyệt qua chuỗi đang xét, nếu bắt gặp dấu phân cách thì bạn đánh dấu lại, chuỗi sẽ nằm trong 2 dấu phân cách, điểm 1 và dấu phân cách đầu tiên, dấu phân cách cuối cùng và điểm kết thúc chuỗi.
# Bạn duyệt qua và dùng 2 biến (start, end) chẳng hạn, duyệt qua thì gặp dấu phân cách thì end biến thành vị trí duyệt.
# Nếu không cho dùng len, mid, left thì bạn cho duyệt qua 10.000 ký tự chẳng hạn, sau đó duyệt qua 1 ký tự thì bạn cũng đưa xuống trang tính, duyệt bao nhiêu đưa xuống cột bấy nhiêu, khi gặp dấu phân cách thì chuyển sang cột mới cho đến hết, hết thì chuyển sang dòng mới.

~~~~~~~~
Tiên học lễ, hậu học văn

 

[VetMini]

Duyệt chuỗi bằng đệ quy (chú ý: cực kỳ kém hiệu quả):

Private rgKQ As Range ' chỉ dùng xuất kết quả, không liên quan đến giải thuật

Sub t()
delim = " "
chuoi = "te te ti te to"
Set rgKQ = [a1]
CatDoan chuoi & delim, delim, "", 1, Len(chuoi)
End Sub

Private Sub CatDoan(ByVal chuoi As String, ByVal delim As String, ByVal doan As String, cur As Long, lngth As Long)
' code đệ quy duyệt chuỗi chuoi, dùng ký tự delim để tách chuỗi thành từng đoạn doan
If Mid(chuoi, cur, 1) = delim Then
XuatDoan doan
doan = ""
Else
doan = doan & Mid(chuoi, cur, 1)
End If
If cur <= lngth Then CatDoan chuoi, delim, doan, cur + 1, lngth
End Sub

Private Sub XuatDoan(ByVal doan As String)
' xuất một đoạn chuỗi. Chỉ dùng để test sub TachDoan
' nếu cần thì sửa code thành nạp đoạn chuõi vào mảng như các bài kia
rgKQ.Value = doan
Set rgKQ = rgKQ.Offset(0, 1)
End Sub

 

[mira1225]

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

Option Explicit

Sub c_l_g_t()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 3)
For i = 1 To rws
    t = 0
    For j = 250000 To 350000
        x = 200 & ";" & j / 100000
        For k = 300000 To 450000
            z = x & ";" & k / 100000
            If z = Nguon(i, 1) Then
                Kq(i, 1) = 200
                Kq(i, 2) = j / 100000
                Kq(i, 3) = k / 100000
               
                t = 1
                Exit For
            End If
        Next k
        If t = 1 Then Exit For
    Next j
Next i
Sheet1.Range("C2").Resize(rws, 3) = Kq
End Sub

@CHAOQUAY e thử code này nhưng không work ra kết quả nhé ạ....

 

[VetMini]

Dùng hàm MID là phạm quy rồi anh ơi. Hahaha ...

.

RegEx không phải là công cụ của VBA, cũng không liên quan đến WorkSheetFunction.
Vậy là dùng RegEx không phạm quy.

 

[CHAOQUAY]

@CHAOQUAY e thử code này nhưng không work ra kết quả nhé ạ....

Sửa lại giới hạn vòng lặp cho phù hợp.
Bạn chạy code với số liệu giả định trong file đính kèm.

Với số liệu thật, có lẽ là sẽ có kết quả đạt yêu cầu, vấn đề là thời gian chưa biết là bao lâu.

Option Explicit

Sub c_l_g_t()
Dim Nguon
Dim Kq
Dim rws
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
rws = UBound(Nguon)
ReDim Kq(1 To 3)
For i = 1 To rws
    t = 0
    For j = 2500001 To 3500000
        x = 200 & ";" & j / 1000000
        For k = 3000001 To 4500000
            z = x & ";" & k / 1000000
            If z = Nguon(i, 1) Then
                Kq(1) = 200
                Kq(2) = j / 1000000
                Kq(3) = k / 1000000
                
                Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(1, 3) = Kq
                t = 1
                Exit For
            End If
        Next k
        If t = 1 Then Exit For
    Next j
Next i
Sheet1.Range("C2").CurrentRegion.Columns.AutoFit
End Sub

 

[VetMini]

... vấn đề là thời gian chưa biết là bao lâu

Với mỗi dòng dữ liệu, code lặp lại con toán j/100000 100000 lần, và k/100000 150000*100000 lần. Số nguyên đã oải, đến số thực thì máy chạy cong đuôi.

Bạn có thể cho "200;" & j/100000 vào một mảng. Và k/100000 vào một mảng khác. Cứ cần đến lúc so sánh thì nối a1(j) & a2(k).

Lý tưởng thì đáng lẽ phải là một mảng. Nhưng mảng 150000*100000 chắc hết bộ nhớ.
Trong điều kiện lý tưởng, chỉ một mảng thì người ta có thể dùng phép dò nhị phân để dò mảng rất hiệu quả. Tình trạng không lý tưởng ở đây thì vẫn có kỹ thuật để dò nhị phân hai mảng. Chỉ là không sử dụng hàm Mid thì code rất rắc rối.

 

[mira1225]

Em xin cảm ơn cả nhà đã hỗ trợ bài code này