몇 개의 셀에서 텍스트를 분리하고 여러 데이터 셀을 생성하는 Excel VBA

Question

누군가 이 데이터를 변환하는 데 필요한 VBA 코딩을 제안해 줬으면 좋겠습니다. 본질적으로 B2와 B3에는 ";"가 더 많더라도 거기와 같은 여러 셀이 있습니다. 그리고 그 뒤에 숫자. T와 I는 변하지 않지만 일부에는 항상 T 또는 I가 있는 것은 아니며 단지 하나의 숫자일 뿐입니다.

최종 출력은 B12:C37이어야 합니다.

나는 본질적으로 옆에 해당 데이터가 있는 숫자 목록을 원합니다. 따라서 1T4는 4개 셀(1열)에서 1,2,3,4가 되어야 하고, 1T5I2는 1,3,5(여기서 I2 = 2개의 정수 간격)입니다. T와 나는 항상 거기에 있을 필요는 없습니다. T가 거기 있다면 나는 거기에 있을 필요가 없습니다. T가 거기 있으면 나는 항상 뒤를 따른다.

셀에 25;45;56;79가 표시되면 25가 한 셀에 들어가고 45가 다른 셀에 들어갑니다.

표시되는 유일한 조합은 1;1T2;1T5I2입니다. 그리고 숫자는 잠재적으로 최대 10000까지의 양의 정수입니다.

B2부터 B20까지 있을 수 있고, 세미콜론은 1000개가 될 수도 있습니다.....

각 문자를 살펴보고 숫자인 경우 T, I 또는 ;로 구분될 때까지 숫자 사이에 문자열을 만드는 루프를 생각하고 있습니다. - 그런데 막혔어요.

내가 Excel에서 원하는 이미지 :

Answer 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