VBA UDF拆分字符串数组

问题描述

我已经写了这个功能，现在我想把它称为工作表函数，如图所示，任何指导都是值得欢迎的：

数组中有两个分号由分号分隔。

 函数CellToRange（strDelimiter As String，可选strColDelimiter As String ）As String 
 
错误GoTo CellToRange_Error 
 
 Dim rnSource，rnDest As Range 
 Dim i As Integer 
 Dim Orig As Variant 
 Dim txt As String 
 Dim intPos As Integer 
 
设置rnSource =范围（F16）
设置rnDest =范围（D21）
 
 txt = rnSource 
 Orig = Split（txt，strDelimiter）
 intPos = InStr（1，txt，strColDelimiter）/ 2 
 
对于i = 0到intPos  -  1 
如果i = intPos  -  1然后
 rnDest.Offset（i）.Value = Mid（Orig（i），1，InStr（1，Orig（i），strColDelimiter） -  1）
 Else 
 rnDest.Offset（i）.Value = Orig（i）
如果i = intPos  -  1然后
 rnDest.Offset（i  - （intPos） -  1）.Value = Mid（Orig（i），InStr（1，Orig（i），strColDelimiter）+ 1，Len（Orig（i）））
 Else 
 rnDest.Offset （i  - （intPos  -  1），1）.Value = Orig（i）
 End If 
 Next i 
 
错误GoTo 0 
 
退出函数
 
 CellToRange_Error：
 
 MsgBoxError&错误编号& （& Err.Description&）在程序CellToRange的函数函数
 
结束函数
  

解决方案

这里是龙。以前没有尝试过，我希望我理解你的权利。

在这个时刻，它需要数字所在的源单元格和目标单元格，它是输出表的左上角单元格。目前的分隔符是，和;对于行和列分别。

从这一点可以修改sub以满足您的需要。

 公共功能mytest（src，dest）
 dest.Parent.Evaluatetest（& src.Address （False，False）&，& dest.Address（False，False）&）
 mytest =wut
 End Function 
 
子测试（src As Range，dest As Range）
 Dim chr，rows，cols 
 rows = 0 
 cols = 0 
对于chr = 1 To Len（src.Value）
选择Case Mid（src.Value，chr，1）
 Case，
 rows = rows + 1 
 Case; 
 cols = cols + 1 
 rows = 0 
 Case Else 
单元格（dest.Row + rows，dest.Column + cols）.Value = Cells（dest.Row + rows ，dest.Column + cols）.Value&中间（src.Value，chr，1）
结束选择
下一个chr 
 End Sub 
  

PS我可能是错的，但这将是最接近的，你可以用UDF修改细胞。

P.P.S. Welp，我的功能实际返回令人惊讶的结果，我会尝试修复它asap，但mb你有其他建议。

I've written this function which works, now I want to be able to call it as a worksheet function as in the pics, any guidance would be welcome:

There are two parts to the array separated by a semi-colon.

Function CellToRange(strDelimiter As String, Optional strColDelimiter As String) As String

    On Error GoTo CellToRange_Error

    Dim rnSource, rnDest As Range
    Dim i As Integer
    Dim Orig As Variant
    Dim txt As String
    Dim intPos As Integer

    Set rnSource = Range("F16")
    Set rnDest = Range("D21")

    txt = rnSource
    Orig = Split(txt, strDelimiter)
    intPos = InStr(1, txt, strColDelimiter) / 2

    For i = 0 To intPos - 1
        If i = intPos - 1 Then
            rnDest.Offset(i).Value = Mid(Orig(i), 1, InStr(1, Orig(i), strColDelimiter) - 1)
        Else
            rnDest.Offset(i).Value = Orig(i)
        End If
    Next i

    For i = intPos - 1 To UBound(Orig)
        If i = intPos - 1 Then
            rnDest.Offset(i - (intPos - 1), 1).Value = Mid(Orig(i), InStr(1, Orig(i), strColDelimiter) + 1, Len(Orig(i)))
        Else
            rnDest.Offset(i - (intPos - 1), 1).Value = Orig(i)
        End If
    Next i

    On Error GoTo 0

    Exit Function

CellToRange_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CellToRange of Function Functions"

End Function

解决方案

Here be dragons. Haven't tryed this before and I hope I understood you right.
At this moment it takes source cell, where numbers are located, and destination cell, which is top left cell of output table. Currently delimiters are "," and ";" for lines and columns respectively.
You can modify sub to suit your needs from this point.

Public Function mytest(src, dest)
    dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ")"
    mytest = "wut"
End Function

Sub test(src As Range, dest As Range)
    Dim chr, rows, cols
    rows = 0
    cols = 0
    For chr = 1 To Len(src.Value)
        Select Case Mid(src.Value, chr, 1)
            Case ","
                rows = rows + 1
            Case ";"
                cols = cols + 1
                rows = 0
            Case Else
                Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1)
        End Select
    Next chr
End Sub

P.S. I might be wrong but this will be the closest as you can get with modifying cells with UDF.
P.P.S. Welp, my Function actualy returns surprising results, I'll try to fix it asap, but mb you have other suggestions.

这篇关于VBA UDF拆分字符串数组的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！