简体   繁体   中英

VBA Array Output to Excel Sheet

I am running into a problem, Although very simple but stuck up, I have a string from a cell, I split the string into characters using Mid function and store it into an array. Now I want to print the array to a different range but I am unable to do it. I've tried many different codes but all in vein. please help.

My Code is as

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

Assuming the array you obtain is "Apple", "Orange", "Grape", "Durian", in order to write into worksheet you cannot directly call the variant. One way to write the value is to first get the length of your variant, then write the value from array starting from index 0, here is how I perform you expectation:

    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

Please take note when perform array loop, you have to minus the length by 1, else it will be out of range, the reason is that array index always start from zero based (0)

And check the post for how to obtain length of array Get length of array?

You have to transpose the array to put values in a column.

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

Some problems with your function:

  • A formula returns a value. It is not used to alter other properties/cells of a worksheet.
    • Hence you should set your results to the function; not try to write to a range
  • Dim k, l, m As Integer only declares m as Integer , k and l are unspecified so they will be declared as a variant.
  • The constructed array will be horizontal. If you want the results vertical, you need to Transpose it, or create a 2D array initially.
  • Option Base 1 is unnecessary since you explicitly declare the lower bound

Assuming you want to use this function on a worksheet, TestIt sets things up.

Note2: The formula on the worksheet assumes you have Excel with dynamic arrays. If you have an earlier version of Excel, you will need to have a different worksheet formula

See your modifed function and TestIt :

Modified with Transpose added to worksheet formula

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

Modified to create 2d vertical array can't really use redim preserve on this array. And I prefer to avoid it anyway because of the overhead

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

在此处输入图像描述

Note:

  • TestIt is merely to test the function . You should enter the appropriate formula yourself, either manually or programmatically, into the destination range.
  • If you do not have dynamic arrays, then you would need to enter an array formula into the destination range; or a formula using the INDEX function to return each element of the array.
  • In TestIt , you might change the line that puts the formula onto the worksheet to Range(Cells(1, 3), Cells(Len([a1]), 3)).FormulaArray = "=Takseer(a1)" , but, again, it is anticipated that you would be entering the correct formula onto your worksheet manually or programmatically anyway.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM