如何从Excel单元格中存储单个单词在VBA中
我有一列短语,想编写一个macros,可以将数据存储在一个锯齿状的数组中,这样每个单独的数组将包含以stringforms存储的特定单元格中的所有单词。
例如,如果列A可能包含以下短语:
foo bar foo hello world test 123
我想创build下面的锯齿arrays:
{{"foo", "bar", "foo"}, {"hello", "world"}, {"test", "123" }}
我对VBA不太熟悉。 我怎样才能声明一个锯齿状的数组? 那么提取单词并将其存储在数组中的最佳方法是什么?
围绕一些拆分使用数组。
dim arr as variant arr = array(split(.range("a1"), chr(32)), split(.range("a2"), chr(32)), split(.range("a3"), chr(32)))
代码将是这样的。
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
当你在一个填充的列中只有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
截图