我在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”公式,但没有运气..
答案 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
范围,以便引用更改为A4
到A10
。这些公式使用波浪线重新格式化文本,以便文本更容易分割(稍后)。
C14
中的公式是C4
的内容。此单元格可以向下复制到C10
。这将从与其相关的块中提取名称。第二个参数是“片段”编号 - 1 =名称,2 =时间1,3 =时间2等。
D14
中的公式是单元格D4
的内容,并且第一次拉出与其相关的块。我没有把其他公式的定义 - 但希望你能看到它们如何被使用的模式。
如果您想要澄清,请给我留言。
答案 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 的新数组变量中。然后它只是读取此数组并将每个项目放入下一个可用单元格。
我希望这可以帮助你开始。一旦您有解决方案,请在此处发布您的最终代码,以帮助可能遇到类似问题的其他人。