![Excel VBA 用于从几个单元格中提取文本并创建多个数据单元格](https://linux22.com/image/1585823/Excel%20VBA%20%E7%94%A8%E4%BA%8E%E4%BB%8E%E5%87%A0%E4%B8%AA%E5%8D%95%E5%85%83%E6%A0%BC%E4%B8%AD%E6%8F%90%E5%8F%96%E6%96%87%E6%9C%AC%E5%B9%B6%E5%88%9B%E5%BB%BA%E5%A4%9A%E4%B8%AA%E6%95%B0%E6%8D%AE%E5%8D%95%E5%85%83%E6%A0%BC.png)
我希望有人能建议在 VBA 中编码以转换这些数据。本质上,B2 和 B3 会有多个单元格,甚至后面会有更多“;”和数字。T 和 I 不会改变,但有些并不总是有 T 或 I,它们只是一个数字。
最终输出需要是B12:C37
我本质上想要一个数字列表,旁边有相应的数据。因此,1T4 应该是 4 个单元格(1 列)中的 1、2、3、4,1T5I2 是 1、3、5(其中 I2 = 相隔 2 个整数)。T 和 I 不一定总是在那里。如果 T 在那里,I 就不必在那里。如果 T 在那里,I 总是在后面。
如果单元格显示 25;45;56;79,则 25 进入 1 个单元格,45 进入另一个单元格,等等。
您唯一能看到的组合是:1;1T2;1T5I2。数字将是正整数,最大可达 10000。
可能有 B2 到 B20,并且分号可能有 1000 个.....
我正在考虑循环查看每个字符,如果它是一个数字,则在数字之间创建一个字符串,直到它被 T、I 或 ; 打断 - 但是我被卡住了。
我在 Excel 中得到的图像:
答案1
Macro3 是一个单元格中的多个分号
Macro2 用于从 B2 到 B20 的多个输入
将此宏复制并粘贴到工作表中并运行它:
Sub Macro3()
'
Dim Txt1, TxtL, Str(), Fruit, Txt As String
Dim x, n, Ff, Tt, Ii, r, i, L, Lx, ix As Integer
r = 12
For x = 2 To 20
Txt1 = Range("B" & x).Value
TxtL = Txt1
Fruit = Range("A" & x).Value
L = Len(Txt1) - Len(Replace(Txt1, ";", ""))
ReDim Str(L)
If Txt1 = "" Then Exit For
For Lx = 0 To L
ix = InStr(1, TxtL, ";")
If ix = 0 Then ix = Len(Txt1) + 1
Str(Lx) = Left(TxtL, ix - 1)
TxtL = Mid(TxtL, ix + 1, Len(Txt1))
Next Lx
For n = 0 To L
Txt = Str(n)
Ff = 0: Tt = 0: Ii = 1
Ff = Val(Txt)
If InStr(1, Txt, "T") > 0 Then Tt = Val(Mid(Txt, InStr(1, Txt, "T") + 1, Len(Txt))) Else Tt = Ff
If InStr(1, Txt, "I") > 0 Then Ii = Val(Mid(Txt, InStr(1, Txt, "I") + 1, Len(Txt))) Else Ii = 1
For i = Ff To Tt Step Ii
Range("D" & r).Value = i
Range("E" & r).Value = Fruit
r = r + 1
Next i
Next n
Next x
MsgBox "done"
End Sub
Sub Macro2()
'
Dim Txt1, Str(4), Fruit, Txt As String
Dim x, n, Ff, Tt, Ii, r, i As Integer
r = 12
For x = 2 To 20
Txt1 = Range("B" & x).Value
Fruit = Range("A" & x).Value
If Txt1 = "" Then Exit For
Str(0) = Left(Txt1, InStr(1, Txt1, ";") - 1)
Str(1) = Mid(Txt1, InStr(1, Txt1, ";") + 1, Len(Txt1))
For n = 0 To 1
Txt = Str(n)
Ff = 0: Tt = 0: Ii = 1
Ff = Val(Txt)
If InStr(1, Txt, "T") > 0 Then Tt = Val(Mid(Txt, InStr(1, Txt, "T") + 1, Len(Txt))) Else Tt = Ff
If InStr(1, Txt, "I") > 0 Then Ii = Val(Mid(Txt, InStr(1, Txt, "I") + 1, Len(Txt))) Else Ii = 1
For i = Ff To Tt Step Ii
Range("D" & r).Value = i
Range("E" & r).Value = Fruit
r = r + 1
Next i
Next n
Next x
MsgBox "done"
End Sub
Sub Macro1()
'
Dim Txt1, Txt2, Str(4), Txt As String
Dim n, Ff, Tt, Ii, r, i As Integer
Txt1 = Range("B2").Value
Txt2 = Range("B3").Value
Str(0) = Left(Txt1, InStr(1, Txt1, ";") - 1)
Str(1) = Mid(Txt1, InStr(1, Txt1, ";") + 1, Len(Txt1))
Str(2) = Left(Txt2, InStr(1, Txt2, ";") - 1)
Str(3) = Mid(Txt2, InStr(1, Txt2, ";") + 1, Len(Txt2))
r = 12
For n = 0 To 3
Txt = Str(n)
Ff = 0: Tt = 0: Ii = 1
Ff = Val(Txt)
If InStr(1, Txt, "T") > 0 Then Tt = Val(Mid(Txt, InStr(1, Txt, "T") + 1, Len(Txt))) Else Tt = Ff
If InStr(1, Txt, "I") > 0 Then Ii = Val(Mid(Txt, InStr(1, Txt, "I") + 1, Len(Txt))) Else Ii = 1
For i = Ff To Tt Step Ii
Range("B" & r).Value = i
If i >= 1 And i <= 10 Then Range("C" & r).Value = "Apple"
If i > 10 Then Range("C" & r).Value = "Mango"
r = r + 1
Next i
Next n
MsgBox "done"
End Sub