2D配列または配列の配列VBA

Question

これはVBAで可能ですか？ 16A、14B、16E、16C、14Dのような文字列があり、この "14、B、D"、 "16、A、C、E"のような配列を生成したいとします。文字はAからEまであり、繰り返されません。私はちょうど最後の部分を生成するために固執しています。多分私のアプローチは完全に間違っていますか？

Sub Test() 
Dim myStr As String 
Dim myStrA As String 
Dim myStrN As String 
Dim FormName As String 
Dim ControlName As String 
Dim myArray() As String 

    'Creating a array list 
    Set arr = CreateObject("System.Collections.ArrayList") 

    'string with values, delimited by comma 
    myStr = "16A,14B,16C,14D,16E"   ' => "16,A,C,E" "14,B,D" 

    'split string into array of substrings 
    myArray = Split(myStr, ",") '=> "16A","14B","16C",",14D","16E" 

    ' adding the elements in the array to array_list 
    For Each element In myArray 
     arr.Add element 
    Next 

    'sorting happens 
    arr.Sort 

    'converting ArrayList to an array 
    'so now a sorted array of elements is stored in the array sorted_array. 
    sorted_array = arr.toarray '=> "14B","14D","16A","16C","16E" 

    'concatenate all elements of array into one string 
    myStr = Join(sorted_array, ",") '=> "14B,14D,16A,16C,16E" 

    'remove letters 
    myStrN = StripNumber(myStr) '=> "14,14,16,16,16" 

    'remove dublipates 
    myStrN = DeDupString(myStrN, ",") '=> "14,16" 

    'stip text 
    myStrA = StripText(myStr) '=> "B,D,A,C,E" 

    PageCount = countSeparators(myStrN, ",") 


    [Forms]![frm_LoanEdit2_Print_HYP]![txt_Company] = myStr 'myStrN & "-" & PageCount 
    [Forms]![frm_LoanEdit2_Print_HYP]![txt_Bullets] = myStrN 


    'display array elements 
    For i = 0 To PageCount - 1 
     FormName = "frm_LoanEdit2_Print_HYP" 
     ControlName = "txt_Page" & i + 1 
     Forms(FormName).Controls(ControlName) = sorted_array(LBound(sorted_array) + i) 
    Next i 
End Sub 

私はこれらの関数を使用して結果を得ようとします。

Function StripText(str As String) As String 
    For i = 1 To Len(str) 
    B = Mid(str, i, 1) 
    Select Case B 
     Case "a" To "z", "A" To "Z", "," 
     StripText = StripText & B 
    End Select 
    Next 
End Function 

Function StripNumber(str As String) As String 
    For i = 1 To Len(str) 
    B = Mid(str, i, 1) 
    Select Case B 
     Case "0" To "9", "," 
     StripNumber = StripNumber & B 
    End Select 
    Next 
End Function 

Function DeDupString(ByVal sInput As String, Optional ByVal sDelimiter As String = ",") As String 
'remove duplicate in string 

    Dim varSection As Variant 
    Dim sTemp As String 

    For Each varSection In Split(sInput, sDelimiter) 
     If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then 
      sTemp = sTemp & sDelimiter & varSection 
     End If 
    Next varSection 

    DeDupString = Mid(sTemp, Len(sDelimiter) + 1) 
End Function 

Answer 1

任意の並べ替えがなければ、私ははい辞書は、おそらく数は、キーとアイテムであることと、取るべき最良のルートとなりますVBA Collectionオブジェクト

Option Explicit 

Public Sub SO_TestCol() 

    Dim inp As String 
    inp = "16A,14B,16E,16C,14D" 

    Dim parts() As String 
    parts = SplitAtTokens(inp, ",") 

    Dim col As New Collection 
    Dim item As Variant, code As String, temp As String 
    For Each item In parts 
     code = Right(item, 1) 
     item = Mid(item, 1, Len(item) - 1) 
     If KeyExists(col, item) Then 
      temp = col(item) & "," & code 
      col.Remove (item) 
      col.Add temp, item 
     Else 
      temp = CStr(item) & "," & code 
      col.Add temp, item 
     End If 
    Next 

    For Each item In col 
     Debug.Print item 
    Next 
    ' Output: 
    ' 16,A,E,C 
    ' 14,B,D 

End Sub 

'--------------------------------------------------------------------------------------- 
' Procedure : KeyExists 
' Author : ja72 
' Date  : 10/2/2017 
' Purpose : Check to see if a key is present in a collection 
'--------------------------------------------------------------------------------------- 
' 
Public Function KeyExists(ByVal col As Collection, ByVal key As Variant) As Boolean 
    Dim item As Variant 
    On Error GoTo NotFound: 
    item = col(key) 
    On Error GoTo 0 
    KeyExists = True 
    Exit Function 
NotFound: 
    KeyExists = False 
End Function 

'--------------------------------------------------------------------------------------- 
' Procedure : SplitAtTokens 
' Author : ja72 
' Date  : 10/2/2017 
' Purpose : Splits a string into an array of strings, delimeted by a token 
'--------------------------------------------------------------------------------------- 
' 
Function SplitAtTokens(ByVal str As String, ByVal tok As String) As String() 
    Dim pos, i, num_of_lines, next_token As Integer 
    Dim res() As String 
    If Not str = vbNullString Then 
     num_of_lines = CountInstances(str, tok) + 1 
     ReDim res(num_of_lines - 1) As String 
     For i = 1 To num_of_lines 
      pos = InStr(1, str, tok, vbTextCompare) 
      If pos > 0 Then 
       res(i - 1) = SplitAt(str, pos - 1) 
       str = Right(str, Len(str) - Len(tok)) 
      Else 
       res(i - 1) = str 
       str = "" 
      End If 
     Next i 
    End If 
    SplitAtTokens = res 
End Function 

'--------------------------------------------------------------------------------------- 
' Procedure : CountInstances 
' Author : ja72 
' Date  : 10/2/2017 
' Purpose : Counts the instances that a token appears in a string 
'    For example `CountInstances("AA-UZ1-0FA2", "A") = 3` 
'--------------------------------------------------------------------------------------- 
' 
Function CountInstances(ByVal str As String, ByVal tok As String) As Integer 
    Dim res, pos As Integer 
    res = 0 
    pos = 0 
    Do 
     pos = InStr(pos + 1, str, tok, vbTextCompare) 
     res = res + 1 
    Loop Until pos = 0 
    CountInstances = res - 1 
End Function 

'--------------------------------------------------------------------------------------- 
' Procedure : SplitAt 
' Author : ja72 
' Date  : 10/2/2017 
' Purpose : Splits a single string into two strings based on location 
'    The first half is returned, the second is assigned to `str` 
'--------------------------------------------------------------------------------------- 
' 
Function SplitAt(ByRef str As String, ByVal at As Integer) As String 
    SplitAt = Left(str, at) 
    str = Mid(str, at + 1) 
End Function