Cách chuyển chuỗi thành mảng

[Lucky070765]

Tôi mới học VBA nên cũng chưa biết nhiều. Tôi có một vấn đề nhờ các anh chị em trong diễn đàn giúp.
Giả sử tôi có chuỗi s="Diễn đàn Giải Pháp Excel", bây giờ tôi muốn tạo một mảng chuỗi mà mỗi phần tử là một ký tự của chuỗi s thì phải code làm sao. Mục đích của tôi là để duyệt qua từng ký tự của chuỗi mà không cần dùng hàm Mid(s, i, j)

 

[tueyennhi]

------------

Arr = .Range("AP5").Resize(R, 1).Value
Data = .Range("AO4").Resize(R, 1).Value

Để tránh không gặp lỗi này nên viết là:

Const START_ROW = 5
If R < START_ROW Then Exit Sub
Arr = .Range("AP" & START_ROW ).Resize(R, 1).Value
Data = .Range("AO" & START_ROW).Resize(R, 1).Value

Mình thử rồi vẫn vậy. Mảng không thiếu mà dư ra ở dòng đầu nên khi chạy vòng lặp duyệt hai mảng thì nó không khớp nhau

 

[tueyennhi]

Bài này đã hơn 8 năm rồi. Lúc đó người viết code chắc muốn biểu diễn regex nên mới làm phức tạp vậy.
Bài này làm cho giản dị là dùng hàm StrConv và Split.

Anh có thể chỉ giúp em không?

 

[VetMini]

Anh có thể chỉ giúp em không?

Thiệt ra bài #9 đã giải đáp câu hỏi của bạn rồi.
Chỉ vì người viết code ấy cho rằng người đọc phải hội đủ 3 điều kiện:
1. có khả năng hiểu code của mình. Quen với loại code "viết 1 lần, dùng 10 trường hợp" (tức là loại code dùng một đống options
2. có khả năng gú gồ và đọc tài liệu tiếng Anh
3. có khả năng hiểu tiếng Anh viết trệch (*) một chút.
Chỉ tiếc rằng trên thực tế, người có 3 điều kiện trên đã tự học được, và không cần nhờ ai cả.

Code vốn chỉ giản dị là:
s = StrConv(s, 64) ' đổi string thànhn unicode. Với Windows, nó sẽ chèn 1 ký tự null sau mỗi ký tự
' ví dụ: "ABC" sẽ thành "ANullBNullCNull" (chuỗi sau chỉ có tính cách minh hoạ)
a = Split(Left(s, Len(s)-1), Chr(0)) ' slit theo ký tự null, bỏ ký tự cuối cùng trong chuỗi s bởi bì chính nó là null

(*) lưu ý là tôi dùng từ "trệch", tôi không nói là "trật". Điển hình là từ "delimiter" được viết trệch thành "delimeter".
limit = giới hạn, biên giới (danh)
delimit = xác định giới hạn (động) - đôi khi, người Anh cũng dùng delimitate.
delimiter = vật thể xác định giới hạn (danh)

 

[HeSanbi]

Anh có thể chỉ giúp em không?

----------------------

Cách viết code của bạn không đồng nhất nên dễ xảy ra lỗi khi áp dụng Range.

Dưới đây là tôi tối ưu lại code của bạn, để bạn biết thêm cách tối ưu bằng cách tạo một biến Range Object duy nhất

Còn lỗi xê dịch hay lệch thì bạn vận dụng Lbound và Ubound

-----------------------

Sub Test()
  Dim Rng As Range, Data As Variant, Arr As Variant
  Dim R As Long, K As Long, I As Long, J As Long
  Dim Tem As String, Dic As Object
  ''------------------------------
  Set Rng = Sheets("MAIN").Range("AO4")
  ''------------------------------
  R = Rng(Rows.Count - Rng.Row, 1).End(xlUp).Row - Rng.Row + 1
  If R <= 0 Then GoTo Ends
  ''------------------------------
  Set Dic = VBA.CreateObject("Scripting.Dictionary")
  Arr = Rng(1, 2).Resize(R, 1).Value
  Arr = Application.Index(Application.Transpose(Arr), 1, 0)
  Arr = SplitStringToNewArray(Arr)
  Data = Rng.Resize(R, 1).Value
  ''------------------------------
  For I = 1 To R
    For J = LBound(Arr, 2) To UBound(Arr, 2)
      If VBA.CDec(Arr(I, J)) > 0 Then
        Tem = CStr(Data(I, 1)) & CStr(Arr(I, J))
        If Not Dic.Exists(Tem) Then
          K = K + 1: Dic.Add Tem, K
        End If
    End If
    Next J
  Next I
Ends: Set Rng = Nothing
      Set Dic = Nothing

End Sub

Public Function SplitStringToNewArray(ByVal InputArray, Optional ByVal delimiter As String = ",", Optional ByVal Limit As Long = -1)
  On Error Resume Next
  Dim SP$(), K As Long, I As Long, J As Long, Max As Long, cSP As Long
  Dim Result(), Arr As Variant
  Arr = InputArray
  For I = 1 To UBound(Arr) - LBound(Arr) + 1
    SP = SplitString(Arr(I), VBA.IIf(Arr(I) Like "*" & delimiter & "*", delimiter, VBA.vbNullChar), Limit)
    cSP = UBound(SP) + 1
    If VBA.Err.Number = 0 Then
      If cSP > Max Then
        ReDim Preserve Result(1 To UBound(Arr) - LBound(Arr) + 1, 1 To cSP)
        Max = cSP
      End If
      For J = 1 To cSP
        Result(I, J) = SP(J - 1)
      Next
    End If
    VBA.Err.Clear
  Next
  SplitStringToNewArray = Result
  On Error GoTo 0
End Function

Public Function SplitString(ByVal Expression As String, Optional ByVal delimiter As String = " ", Optional ByVal Limit As Long = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As String()
  If delimiter = VBA.vbNullChar Or delimiter = VBA.vbNullString Then
    Expression = VBA.StrConv(Expression, VBA.vbUnicode)
    Expression = VBA.Left(Expression, Len(Expression) - 1)
    delimiter = VBA.vbNullChar
  End If
  SplitString = VBA.Split(Expression, delimiter, Limit, Compare)
End Function