VBA UDF拆分字符串数组 [英] VBA UDF to split string array

查看:181
本文介绍了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拆分字符串数组的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆