VBA自定义函数：将字符串拆分成二维数组

fanjy

发布于 2024-03-12 13:49:23

1250

发布于 2024-03-12 13:49:23

文章被收录于专栏：完美Excel完美Excel

标签：VBA，自定义函数

下面是在forum.ozgrid.com看到的一段VBA程序，值得参考，特辑录于此。

这个自定义函数将字符串拆分成二维数组。在调用该函数时，只需指定字符串、希望生成的数组具有的列数以及用于将字符串转换为二维数组的分隔符。默认的分隔符是空格字符，但可以是想要的任何字符，它将计算所需的行数。

VBA自定义函数如下：

Option Base 0
'将字符串转换为二维数组 - 默认使用空格作为分隔符
Public Function Str_2d(str As String, intCol, Optional Delim As String = " ") As Variant
 Dim Num_Rows As Long
 Dim arrTemp, arrTemp2
 Dim iCount As Integer
 Dim Row_Count As Integer
 Dim Col_Count As Integer
 '确定结果数组的大小和形状 - 列数和行数
 Num_Rows = Application.RoundUp((Len(str) - Len(Replace(str, Delim, "")) + 1) / intCol, 0)
 'icount是arrtemp的索引，它是一个从零开始的数组
 arrTemp = Split(str, Delim)
 iCount = 0
 ReDim arrTemp2(Num_Rows - 1, intCol - 1)
 For Row_Count = 1 To Num_Rows
   For Col_Count = 1 To intCol
     arrTemp2(Row_Count - 1, Col_Count - 1) = Trim(arrTemp(iCount))
     iCount = iCount + 1
     If iCount > UBound(arrTemp) Then
       Exit For
   Next
 Next
 Str_2d = arrTemp2
End Function

下面的过程调用上述函数进行测试：

Public Sub test()
 Dim x
 ActiveSheet.Cells.Clear
 x = Str_2d("This is a sweet function for 2 dimensional arrays Ha! Ha", 3)
 '或者
 'x = Str_2d("This is a sweet function^for 2 dimensional arrays^Ha! Ha", 3, "^")
 '或者
 'x = Str_2d("This is a sweet,function for 2,dimensional,arrays,Ha! Ha", 1, ",")
 '显示结果....
  ActiveSheet.Range("A1").Resize(UBound(x, 1) + 1, UBound(x, 2) + 1) = x
End Sub

结果如下图1所示。