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

Liên hệ QC

Người dùng đang xem chủ đề này

mira1225

Thành viên mới
Tham gia
21/2/22
Bài viết
9
Được thích
0
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
 

File đính kèm

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
Thử code này xem:
Mã:
Option Explicit

Sub KhongSplit()
Dim sArr(), dArr(), sU1 As Long, I As Long, J As Long
Dim Val As String, Pos1 As Long, Pos2 As Long
With Sheets("Website 1")
    sArr = .Range("A1", .Cells(Rows.Count, "A").End(xlUp)).Value
    sU1 = UBound(sArr, 1)
    ReDim dArr(1 To sU1, 1 To 3)
    For I = 1 To sU1
        J = Len(sArr(I, 1)) - Len(Replace(sArr(I, 1), ";", ""))
        If J + 1 > UBound(dArr, 2) Then ReDim Preserve dArr(1 To sU1, 1 To J + 3)
        J = 0
        Val = ";" & sArr(I, 1) & ";"
        Pos1 = 1
        Do
            Pos2 = InStr(Pos1 + 1, Val, ";")
            If Pos2 = 0 Then Exit Do
            J = J + 1
            dArr(I, J) = Mid(Val, Pos1 + 1, Pos2 - Pos1 - 1)
            Pos1 = Pos2
        Loop
    Next
    .Range("B1").Resize(10000, UBound(dArr, 2)).ClearContents
    .Range("B1").Resize(sU1, UBound(dArr, 2)) = dArr
End With
End Sub
 
Upvote 0
PHP:
...
 
Lần chỉnh sửa cuối:
Upvote 0
. . . . 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()
Cái "trong qui định" của bạn không thể đem áp đặt cho GPE.COM
Hay là bạn ra đề bài đánh đố diễn đàn đó nhỉ?
 
Upvote 0
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
............................................
Mã:
Option Explicit

Sub Macro1()
With Sheets("Website 1")
    .Range("A1", .Range("A1").End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
End With
End Sub
 
Upvote 0
Chứng tỏ chưa tham khảo hết.
Tham khảo cẩu thả, dối trá. Khong biết rằng muốn nhận được trả lời của gu-ru thì phải tránh viết tắt.
Tuy nhiên, phải nhìn nhận rằng có tham khảo về hiện tượng đói bài. Một vấn đề nghịch lý (*1) thế mà cũng có khối người code thử.

Cái "trong qui định" của bạn không thể đem áp đặt cho GPE.COM
Hay là bạn ra đề bài đánh đố diễn đàn đó nhỉ?
Đánh đố đứt đuôi rồi chứ còn gì nữa.
Nhưng ở đây là để loè bạn gái, hoặc đánh cá trên bàn nhậu. Chứ chắc chắc không thực tế rồi.

(*1) nếu là những cái bên ngoài như "đít sần", "ADO", "RegEx", ... thì có thể biện hộ lý do không dùng. Bởi chúng phụ thuộc vào nền tảng và môi trường.
Split là hàm chân chính của VBA. Trước mắt là nó hiệu quả gấp bội lần các code thay thế - trừ phi người viết rất giỏi về cách lái hàm theo dữ liệu. Không dùng nó là tự làm khó mình.

(*2) lái hàm theo dữ liệu để tối ưu hoá hiệu quả: tôi không tin là trên GPE này có người đạt trình độ này, kể cả tôi. Ở đây có một tay rất giỏi về tối ưu hoá code, và có khả năng viết các hàm phụ bằng ngôn ngữ tối ưu. Nhưng tôi không tin là ngwoif này đủ kinh nghiệm về dữ liệu để "nắn" hàm.
 
Upvote 0
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
Mình thắc mắc tại sao bạn lại không muốn dùng hàm Split.
Tuy nhiên với yêu cầu của bạn cũng chỉ là trò chơi ABC thôi
Mã:
Sub Tach_Khong_Split()
Columns("A:A").TextToColumns Range("B1"), xlDelimited
End Sub
****************
Gởi bài rồi mới thấy bài số 6 có cùng cách xử lý
Bài đã được tự động gộp:

Cái "trong qui định" của bạn không thể đem áp đặt cho GPE.COM
Hay là bạn ra đề bài đánh đố diễn đàn đó nhỉ?
Bớt khó chút đi bác. Kệ đi. Cuối cùng cũng đều như nhau thôi mà.
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn @Nhattanktnn đã hỗ trợ, chắc em thiếu sót trong câu hỏi vì đề bài yêu cầu không dùng Excel function luôn ạ. Có thể đây là một câu hỏi cơ bản nhưng vì mới học VBA nên rất mong cả nhà hỗ trợ.
Trong code @Nhattanktnn chia sẻ lại có InStr() ạ ...
Thử code này xem:
Mã:
Option Explicit

Sub KhongSplit()
Dim sArr(), dArr(), sU1 As Long, I As Long, J As Long
Dim Val As String, Pos1 As Long, Pos2 As Long
With Sheets("Website 1")
    sArr = .Range("A1", .Cells(Rows.Count, "A").End(xlUp)).Value
    sU1 = UBound(sArr, 1)
    ReDim dArr(1 To sU1, 1 To 3)
    For I = 1 To sU1
        J = Len(sArr(I, 1)) - Len(Replace(sArr(I, 1), ";", ""))
        If J + 1 > UBound(dArr, 2) Then ReDim Preserve dArr(1 To sU1, 1 To J + 3)
        J = 0
        Val = ";" & sArr(I, 1) & ";"
        Pos1 = 1
        Do
            Pos2 = InStr(Pos1 + 1, Val, ";")
            If Pos2 = 0 Then Exit Do
            J = J + 1
            dArr(I, J) = Mid(Val, Pos1 + 1, Pos2 - Pos1 - 1)
            Pos1 = Pos2
        Loop
    Next
    .Range("B1").Resize(10000, UBound(dArr, 2)).ClearContents
    .Range("B1").Resize(sU1, UBound(dArr, 2)) = dArr
End With
End Sub
 
Upvote 0
Cảm ơn @Nhattanktnn đã hỗ trợ, chắc em thiếu sót trong câu hỏi vì đề bài yêu cầu không dùng Excel function luôn ạ. Có thể đây là một câu hỏi cơ bản nhưng vì mới học VBA nên rất mong cả nhà hỗ trợ.
Trong code @Nhattanktnn chia sẻ lại có InStr() ạ ...
Xong, các thầy:unknw: bị bom :D
Chắc đi học VBA, được ông thầy nào bắt làm tách chuỗi, không được sử dụng các hàm dựng sẵn, chỉ được dùng vòng lặp.
:1a:
 
Lần chỉnh sửa cuối:
Upvote 0
Các thầy/cô nhà ta hay cấm xài cái này hay cái kia trong đề bài của mình nhỉ;
Thay vì thế nên ghi trong đề bài là:
1./ Nếu xài Split thì đạt 2 điểm (của câu này)
2./ Nếu không thì đạt 5 điểm khi đạt kết quả theo iêu cầu đề ra.
Còn cách ngăn cấm kiến thức này nọ cũng giống thời ngăn sông cấm chợ mà thôi, bỏ đi!
 
Upvote 0
Xong, các thầy:unknw: bị bom :D
Chắc đi học VBA, được ông thầy nào bắt làm tách chuỗi, không được xử dụng các hàm dựng sẵn, chỉ được dùng vòng lặp.
:1a:
Thầy/cô kém khả năng trình bày câu hỏi, không biết cách diễn tả điều kiện bài tập.
Nhưng cũng có thể thầy/cô nói rất rõ, chỉ do học sinh diễn đạt lại mất ý nghĩa.

Các thầy/cô nhà ta hay cấm xài cái này hay cái kia trong đề bài của mình nhỉ;
...
Như trên, do thầy/cô hoặc học sinh kém khả năng chứ không phải do cấm xài này nọ.
Đề bài chỉ cần nói: Viết hàm dùng phương pháp duyệt từng ký tự để tách chuỗi, kết quả tương tự như dùng hàm Split.
Loại bài tập ép duyệt chuỗi này đối với học lập trình là bình thường. Tuy rằng nếu tôi dạy thì tôi ra kiểu khác, kích động óc sáng tạo hơn, kiểu này máy móc quá.

Tuy nhiên, bài này muốn chơi loè thầy cô thì dùng RegEx. :p
 
Upvote 0
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
............................................
Mã:
Option Explicit

Sub Macro1()
With Sheets("Website 1")
    .Range("A1", .Range("A1").End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
End With
End Sub
Bài đã được tự động gộp:

Mình thắc mắc tại sao bạn lại không muốn dùng hàm Split.
Tuy nhiên với yêu cầu của bạn cũng chỉ là trò chơi ABC thôi
Mã:
Sub Tach_Khong_Split()
Columns("A:A").TextToColumns Range("B1"), xlDelimited
End Sub
****************
Gởi bài rồi mới thấy bài số 6 có cùng cách xử lý
Bài đã được tự động gộp:


Bớt khó chút đi bác. Kệ đi. Cuối cùng cũng đều như nhau thôi mà.
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
 
Upvote 0
Nói rồi. Hỏi bài mà hời hợt, dùng tiếng viết tắt thì gu-ru chê, hổng thèm làm.
 
Upvote 0
Rồi, rồi: Trúng mánh rồi 2uang Hải ơi! Xin chúc mừng chú mày nha.
 
Upvote 0
Dùng hàm dựng sẵn còn không cho. Anh xúi dùng thư viện thì khả năng cao là bị đuổi học. :cray:
RegEx nói là thách đố nhau chơi chứ không phải code giùm cho thớt kiếm điểm.

Theo như cách nói chuyện thì thớt đâu phải không biết code. Có lẽ chỉ nhát, không muốn tự làm lấy thôi.
 
Upvote 0
@VetMini không biết việc xin giúp đỡ từ mọi người trên diễn đàn lần đầu ghé thăm có gì sai sót không, nhưng qua cách nói chuyện của @VetMini nhiều lần khiến mình cảm thấy mình không thể im lặng bỏ qua tiếp.
1. Mình cảm ơn sự góp ý nếu nó thiện chí, đặc biệt các anh chị ở trên đã chia sẻ
2. Code mình đã tự mò và thử làm rồi, chạy tốt vì có dùng function excel Split() và TexttoColumns để tách dữ liệu. Nếu lười biếng thì mình đã không hiểu được những gì anh chị trên đã chia sẻ, không phaỉ sao?. Tuy nhiên giáo viên lại không cho phép, và yêu cầu không dùng chức năng excel, điều đó làm mình bối rối nên mới xin hỗ trợ từ mọi người
3. Thái độ của @VetMini trong comment thật khiến mình "mở rộng tầm mắt", bạn có thể phớt lờ bài đăng của mình nếu bạn không muốn trả lời, vì mình cần sự giúp đỡ thực sự, không phải là sự đánh giá từ bạn

Xin lỗi anh chị em khác trong diễn đàn vì kéo dài bài viết vì điều này
 
Upvote 0
... nhiều lần khiến mình cảm thấy mình không thể im lặng bỏ qua tiếp.
Đã 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ì?
 
Upvote 0
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.
 
Upvote 0
Đã 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.
 
Upvote 0
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.
 
Upvote 0
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
Mã:
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
 
Upvote 0
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
Mã:
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
 
Lần chỉnh sửa cuối:
Upvote 0
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.

Mã:
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
 
Upvote 0
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:


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
Mã:
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
 
Upvote 0
Đú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.
 
Upvote 0
...
+ 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.
 
Upvote 0
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.
 
Upvote 0
Cảm ơn @CHAOQUAY nhiều nhé

Bạn chạy code dưới đây
Mã:
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:

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
 
Upvote 0
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
 
Upvote 0
Bạn chạy code dưới đây
Mã:
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é ạ....
 
Upvote 0
@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.
Mã:
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
 

File đính kèm

Upvote 0
... 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.
 
Lần chỉnh sửa cuối:
Upvote 0
Em xin cảm ơn cả nhà đã hỗ trợ bài code này
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom