VBA 数组输出到 Excel 工作表

Question

我遇到了一个问题，虽然很简单但卡住了，我有一个来自单元格的字符串，我使用 Mid 函数将字符串拆分为字符并将其存储到一个数组中。现在我想将数组打印到不同的范围，但我无法做到。我尝试了许多不同的代码，但都是一致的。 请帮忙。

我的代码是

Option Base 1
Function Takseer(Rg As Variant)
    Dim NewArray() As Variant
    Dim StrEx As String
    Dim k, l, m  As Integer
    StrEx = Rg
    StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
    m = Len(StrEx)
    For k = 1 To m
        ReDim Preserve NewArray(1 To m)
            NewArray(k) = Mid(StrEx, k, 1)
    Next k
    Range("C1:C12") = NewArray

End Function

Answer 1

您必须转置数组以将值放入列中。

Option Explicit
Option Base 1

Sub test()
   Call Takseer("ABCDEFGHUIJKL")
End Sub

Function Takseer(StrEx As String)

    Dim NewArray() As Variant, s As String, m As Integer, k As Integer
    s = Replace(StrEx, " ", "")
    m = Len(s)
    If m = 0 Then Exit Function
    ReDim NewArray(m)
    For k = 1 To m
        NewArray(k) = Mid(s, k, 1)
    Next k
    ' in a row
    Sheet1.Range("C1").Resize(1, m) = NewArray
    ' in a column
    Sheet1.Range("C2").Resize(m, 1) = WorksheetFunction.Transpose(NewArray)

End Function

Answer 2

假设您获得的数组是“Apple”、“Orange”、“Grape”、“Durian”，为了写入工作表，您不能直接调用变体。写入值的一种方法是首先获取变量的长度，然后从索引 0 开始的数组中写入值，这是我执行您期望的方式：

    Sub test1()

    Dim NewArray() As Variant
    Dim i As Long, arrayLoop As Long
    Dim StrEx As String
    Dim k, l, m  As Integer
    
    StrEx = "Hello today is my first day"
    StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
    m = Len(StrEx)
    
    For k = 0 To m - 1
       ReDim Preserve NewArray(m - 1)
            NewArray(k) = Mid(StrEx, k + 1, 1)
    Next k

    
    i = UBound(NewArray) - LBound(NewArray) + 1

    For arrayLoop = 0 To i - 1
        Sheet1.Range("A" & arrayLoop + 1).Value = NewArray(arrayLoop)
    Next

End Sub

在执行数组循环时请注意，必须将长度减1，否则会超出范围，原因是数组索引总是从零开始（0）

并查看帖子以了解如何获取数组长度Get length of array?

Answer 3

您的功能存在一些问题：

• 公式返回一个值。它不用于更改工作表的其他属性/单元格。
  • 因此您应该将结果设置为函数；不要尝试写入范围
• Dim k, l, m As Integer 仅将 m 声明为 Integer、k 和 l 未指定，因此它们将被声明为变体。
• 构造的数组将是水平的。如果你希望结果是垂直的，你需要Transpose它，或者最初创建一个二维数组。
• Option Base 1 是不必要的，因为您明确声明了下限

假设您想在工作表上使用此功能，TestIt 进行设置。

注意 2：工作表上的公式假定您拥有带有动态数组的 Excel。如果您使用的是早期版本的 Excel，则需要使用不同的工作表公式

查看修改后的函数和TestIt：

在工作表公式中添加了转置修改

Option Explicit
Function Takseer(Rg As Variant)
    Dim NewArray() As Variant
    Dim StrEx As String
    Dim k As Long, l As Long, m  As Long
    StrEx = Rg
    StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
    m = Len(StrEx)
    For k = 1 To m
        ReDim Preserve NewArray(1 To m)
            NewArray(k) = Mid(StrEx, k, 1)
    Next k
    Takseer = NewArray

End Function

Sub TestIt()
    [a1] = "abcdefg"
    [c1].EntireColumn.Clear
    [c1].Formula2 = "=Transpose(Takseer(A1))"
End Sub

修改为创建二维垂直阵列 不能在这个数组上真正使用redim preserve。由于开销，我更愿意避免它

Option Explicit
Function Takseer(Rg As Variant)
    Dim NewArray() As Variant, col As Collection
    Dim StrEx As String
    Dim k As Long, l As Long, m  As Long
    StrEx = Rg
    StrEx = WorksheetFunction.Substitute(StrEx, " ", "")
    m = Len(StrEx)
    
    Set col = New Collection
    For k = 1 To m
        col.Add Mid(StrEx, k, 1)
    Next k
    
    ReDim NewArray(1 To col.Count, 1 To 1)
    For k = 1 To col.Count
        NewArray(k, 1) = col(k)
    Next k
    
    Takseer = NewArray

End Function

Sub TestIt()
    [a1] = "abcdefg"
    [c1].EntireColumn.Clear
    [c1].Formula2 = "=Takseer(A1)"
End Sub

注意：

• TestIt 只是为了测试功能。您应该自己手动或以编程方式将适当的公式输入到目标范围中。
• 如果您没有动态数组，则需要在目标范围内输入数组公式；或使用INDEX 函数的公式返回数组的每个元素。
• 在TestIt 中，您可能会将将公式放入工作表的行更改为Range(Cells(1, 3), Cells(Len([a1]), 3)).FormulaArray = "=Takseer(a1)"，但同样，预计您将手动或以编程方式将正确的公式输入工作表。李>