我有一个需要拆分为多个的单列,就像 Excel 中的文本到列一样。然而,有一个小挑战。传统的分隔符不起作用。考虑下面的字符串
Original: Domain\Domain Admins Domain2\User Group Domain3\Developers .....(And so on)
Required: Domain\Domain Admins | Domain2\User Group | Domain3\Developers .....(And so on)
所需字符串中的管道表示需要在此处进行拆分并根据字符串的长度复制到下一列。
我在 A 列中有一个包含 506 行的列表。我使用以下公式检查 B 列中“\”的出现情况,计数范围为 0-66
=LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))
我需要帮助按照逻辑进行编码
- 在字符串中查找“\”
- 找到“\”之前的空格并拆分
我使用了以下代码,但它没有达到目的
Range("A1:A506").Select
Selection.TextToColumns
请帮助提供一个牢记第 1 点和第 2 点的代码。
答案1
虽然我使用了与您的要求不同的逻辑,但这样应该可以做到。
您想在空格前找到一个 \,而我的代码只是寻找Domain
(注意空格)。
Option Explicit
Sub DoThis()
Dim col As Integer
col = 65
Dim splitWord As String
splitWord = "Domain"
Dim row As Integer
row = 1
Do While (Range("A" & row).value <> "")
Dim value As String
value = Range("A" & row).value
Dim values() As String
values = Split(value, " " & splitWord)
Dim firstResult As String
Dim i As Integer
For i = 1 To UBound(values)
firstResult = values(0) ' not efficient but easier code to read
Range(Chr(col + i) & row).value = splitWord & values(i)
Next i
Range(Chr(col) & row).value = firstResult
row = row + 1
col = 65
Loop
End Sub
前
后
请注意,我稍微更新了一些文字以显示它复制了正确的数据,但它也已通过您的示例进行了测试。
在测试之前,请务必先备份您的数据,因为这样的宏是无法撤消的!
答案2
Sub ExtractBySlash()
暗淡rAs范围
Dim subS 作为变体
暗色 x 同长色
暗淡如长
暗淡的计数器
计数器 = 1
对于范围内的每个 r(“a1:a506”)
subS = Split(r.Text, "\")
For x = LBound(subS) + 1 To UBound(subS)
For y = Len(subS(x)) To 1 Step -1
If Mid(subS(x), y, 1) = " " Then
r.Offset(0, counter) = subS(x - 1) & "\" & Left(subS(x), y)
subS(x) = Trim(Right(subS(x), Len(subS(x)) - y))
counter = counter + 1
Exit For
End If
Next y
Next x
下一个
子目录结束