excel vba - 分割一个非常复杂的字符串

时间:2013-11-16 01:32:19

标签: string excel vba

我在Excel中收到了一个工作表,其中包含一个列中的孩子名称和视频时间标记,我需要将其排序为逻辑格式,以便我可以使用它。但是,该列表没有分隔符..所以我希望有人可以帮助我使用VBA Excel宏。

下面是一个示例(缩短)字符串,假设这是在单元格A1中。

“Sandy 25:1132:27Giorgio  09:1114:7Anne Marie 32:10大卫17:48马蒂  04:3506:1010:3613:1014:32Sandy(2)04:30Brian 13:4714:37“

我最好将字符串拆分为单元格,如下所示

细胞A2桑迪

Cell A3 25:11

Cell A4 32:27

Cell A5 Giorgio

Cell A6 09:11

Cell A7 14:7

Cell A8 Anne Marie

Cell A9 32:10

Cell A10 David

Cell A11 17:48

Cell A12 Marty

Cell A13 04:35

Cell A14 06:10

Cell A15 10:36

Cell A16 13:10

Cell A17 14:32

细胞A18桑迪(2)

Cell A19 04:30

Cell A20 Brian

Cell A21 13:47

Cell A22 14:37

我尝试过使用一些基本的“查找”和“len”公式,但没有运气..

2 个答案:

答案 0 :(得分:1)

不能完全按照你的意愿行事 - 但它可能会帮助你朝着一个方向前进......希望它会成为正确的......

我将您的字符串粘贴到工作表中的单元格A1中,然后将此代码写入工作表中的模块中: -

Function parseText(ByVal text As String, ByVal domain As Integer) As String
    Dim returnValue As String
    Dim colon As Integer
    Dim soFar As Integer
    soFar = 0
    text = Trim(text)
    While soFar < domain
        colon = InStr(text, ":")
        While (Mid(text, colon + 5, 1) = ":")
            colon = colon + 5
        Wend
        returnValue = Mid(text, 1, colon + 2)
        While Not (IsNumeric(Right(returnValue, 1)))
            returnValue = Left(returnValue, Len(returnValue) - 1)
        Wend
        text = Replace(text, returnValue, "")
        soFar = soFar + 1
    Wend
    parseText = returnValue
End Function

Function parseDomain(ByVal domain As String) As String
    Dim returnValue As String
    Dim part As String
    While Len(domain) > 0
        part = ""
        If InStr(domain, ":") > 0 Then
            part = Mid(domain, InStrRev(domain, ":") - 2, 5)
            returnValue = part & "~" & returnValue
            domain = Left(domain, Len(domain) - Len(part))
        End If
        If part = "" Then
            returnValue = Trim(domain) & "~" & Left(returnValue, Len(returnValue) - 1)
            domain = ""
        End If
    Wend
    parseDomain = returnValue
End Function

Function pullPiece(ByVal block As String, ByVal piece As Integer) As String
    Dim returnValue As String
    Dim pieces() As String
    pieces = Split(block, "~")
    If piece > UBound(pieces) + 1 Then
        returnValue = ""
    Else
        returnValue = pieces(piece - 1)
    End If
    pullPiece = returnValue
End Function

这一点很难解释......

在下图中,A14中的公式是单元格A4的内容。 A15中的公式是单元格A5等的内容,一直到A10。这些公式突破了每个名称的文本块。

B14中的公式是B4的内容。然后可以将此单元格向下复制到B10范围,以便引用更改为A4A10。这些公式使用波浪线重新格式化文本,以便文本更容易分割(稍后)。

C14中的公式是C4的内容。此单元格可以向下复制到C10。这将从与其相关的块中提取名称。第二个参数是“片段”编号 - 1 =名称,2 =时间1,3 =时间2等。

D14中的公式是单元格D4的内容,并且第一次拉出与其相关的块。我没有把其他公式的定义 - 但希望你能看到它们如何被使用的模式。

sheet with formula usage

如果您想要澄清,请给我留言。

答案 1 :(得分:0)

由于时间戳看起来不符合类似的格式,因此难以解析字符串。例如,大多数都遵循 00:00 格式,但是您希望放置在单元格 A7 中的值仅在冒号后面有一个数字。因此,我创建了一些代码,以帮助您开始正确的方向,但这是基于 00.00 格式的假设,目前不解析数字后面的文本。但如果你进行更多的研究,我相信你可以从这一点完成:

Public Sub TestCode()

Dim strTest As String, strModify() As String, strNew() As String, x As Long

strTest = "Sandy 25:1132:27Giorgio 09:1114:7Anne Marie 32:10David 17:48Marty 04:3506:1010:3613:1014:32Sandy (2) 04:30Brian 13:4714:37"

strModify = Split(strTest)

ReDim strNew(0 To 0)
strNew(0) = strModify(0)
For x = 1 To UBound(strModify)
    If Left(strModify(x), 1) Like "[A-Z]" Then
        ReDim Preserve strNew(0 To (UBound(strNew) + 1))
        strNew(UBound(strNew)) = strModify(x)
    ElseIf Left(strModify(x), 1) Like "[0-9]" Then
        Do Until InStr(1, strModify(x), ":") = 0
            ReDim Preserve strNew(0 To (UBound(strNew) + 1))
            strNew(UBound(strNew)) = Left(strModify(x), InStr(1, strModify(x), ":") + 2)
            strModify(x) = Right(strModify(x), Len(strModify(x)) - (InStr(1, strModify(x), ":") + 2))
        Loop
    Else
        strNew(UBound(strNew)) = strNew(UBound(strNew)) & " " & strModify(x)
   End If
Next x

For x = 0 To UBound(strNew)
    Range("A1").Offset(0, x).Value = strNew(x)
Next x

End Sub

为了帮助您理解代码以便修改,这基本上是将原始字符串拆分到有空格的地方(结果放在名为 strModify 的数组中)。然后它检查字符串中的第一个字符,看它是字母,数字还是其他字符。根据这些信息,它会将字符串的各个组件放入一个名为 strNew 的新数组变量中。然后它只是读取此数组并将每个项目放入下一个可用单元格。

我希望这可以帮助你开始。一旦您有解决方案,请在此处发布您的最终代码,以帮助可能遇到类似问题的其他人。