Question

我有一列短语，想写一个可以将数据存储在锯齿状数组中的宏，这样每个单独的数组都会包含存储为字符串的特定单元格中的所有单词。

例如，如果列A可以包含以下短语：

foo bar foo    
hello world    
test 123

我想创建以下锯齿状数组：

{{"foo", "bar", "foo"}, {"hello", "world"}, {"test", "123" }}

我对VBA不太熟悉。如何声明锯齿状数组？什么是提取单个单词并将其存储在该数组中的最佳方法？

Answer 1

在某些拆分周围使用数组。

dim arr as variant
arr = array(split(.range("a1"), chr(32)), split(.range("a2"), chr(32)), split(.range("a3"), chr(32)))

Answer 2

代码就是这样。

Sub test()
    Dim vDB, vR(), vResult()
    Dim vSplit, i As Long, j As Integer
    Dim myArray As String
    vDB = Range("a1", Range("a" & Rows.Count).End(xlUp))

    For i = 1 To UBound(vDB, 1)
        vSplit = Split(Trim(vDB(i, 1)))
        'ReDim vR(0)
        For j = 0 To UBound(vSplit)
            ReDim Preserve vR(j)
            vR(j) = Chr(34) & vSplit(j) & Chr(34)
        Next j
        ReDim Preserve vResult(1 To i)
        vResult(i) = "{" & Join(vR, ",") & "}"
    Next i
    myArray = "{" & Join(vResult, ",") & "}"
    Range("b1") = myArray
End Sub

Answer 3

如果您在一个已填充的列中只有3个或4个单元格，但如果您说10个单元格或更多单元格，则很容易变得困难。请改用collection of collections

'~~> API to Create a GUID, a unique 128-bit integer used for 
'~~> CLSIDs and interface identifiers.
'~~> We will use it create unique key for our collection
Private Declare Function CoCreateGuid Lib "ole32.dll" (pGUID As Any) As Long

Public Sub Sample()
    Dim JagCol As New Collection, item As Collection
    Dim i As Long, j As Long, lRow As Long

    Dim ws As Worksheet
    Dim tmpAr As Variant, itm As Variant, subItm As Variant

    '~~> Change this to the relevant sheet
    Set ws = Sheet1

    With ws
        '~~> Find Last Row
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Loop through the cells in Col A
        For i = 1 To lRow
            Set item = New Collection

            tmpAr = Split(.Range("A" & i).Value)

            '~~> Create a sub collection
            For j = LBound(tmpAr) To UBound(tmpAr)
                item.Add tmpAr(j), CreateGUID
            Next j

            '~~> Add sub collection to  major collection
            JagCol.Add item
        Next i
    End With

    For Each itm In JagCol
        For Each subItm In itm
            Debug.Print subItm
        Next
        Debug.Print "-----"
    Next
End Sub

'~~> Function to create unique key
Public Function CreateGUID() As String
    Dim i As Long, b(0 To 15) As Byte
    If CoCreateGuid(b(0)) = 0 Then
        For i = 0 To 15
            CreateGUID = CreateGUID & Right$("00" & Hex$(b(i)), 2)
        Next i
    End If
End Function

<强>截图

如何在VBA中存储Excel单元格中的单个单词

3 个答案: