☰

Excel VBA для извлечения текста из нескольких ячеек и создания нескольких ячеек данных

tag-icon • tag-icon microsoft-excel vba
Excel VBA для извлечения текста из нескольких ячеек и создания нескольких ячеек данных

Я бы хотел, чтобы кто-нибудь предложил кодировку в VBA, необходимую для преобразования этих данных. По сути, B2 и B3 будут иметь несколько ячеек, как там, даже с большим количеством ";" и цифр после. T и I не изменятся, но некоторые не всегда имеют T или I, они просто являются одним числом.

Окончательный вывод должен быть B12:C37

По сути, мне нужен список чисел с соответствующими данными рядом с ним. Так, 1T4 должно быть 1,2,3,4 в 4 ячейках (в 1 столбце), 1T5I2 должно быть 1,3,5 (где I2 = 2 целых числа). T и I не всегда должны быть там. Если T есть, I не обязательно должен быть там. Если T есть, I всегда после.

Если в ячейке указано 25;45;56;79, то 25 помещается в одну ячейку, 45 — в другую и т. д.

Единственные комбинации, которые вы увидите, это: 1;1T2;1T5I2. И числа будут положительными целыми числами, потенциально до 10000.

Там могут быть B2-B20, а точек с запятой может быть 1000...

Я думаю о цикле, который будет просматривать каждый символ и, если это число, создавать строку между числами, пока она не будет разорвана символом T, I или ; - Однако я застрял.

Изображение того, что мне нужно в Excel:

что мне нужно в Excel

решение1

Макрос3 — это несколько точек с запятой в одной ячейке.
Макрос2 предназначен для нескольких входных данных от 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

Связанный контент