Имеется запись в ячейке: 1,2-5,10. Нужно чтобы получился ряд чисел:1, 2, 3, 4, 5, 10. Каждое число нужно записать в отдельную ячейку. Собственно для чего это нужно: позиции по чертежу перечислены в строку, нужно чтобы EXCEL "понял" что там за позиции для того чтобы подцепить дополнительную информацию из других таблиц. Заранее спасибо.
Имеется запись в ячейке: 1,2-5,10. Нужно чтобы получился ряд чисел:1, 2, 3, 4, 5, 10. Каждое число нужно записать в отдельную ячейку. Собственно для чего это нужно: позиции по чертежу перечислены в строку, нужно чтобы EXCEL "понял" что там за позиции для того чтобы подцепить дополнительную информацию из других таблиц. Заранее спасибо.bop4yh
Sub bop4yh() Dim a, i&, S$, a1, II& a = Split(Replace(Range("A2"), " ", ""), ",") For i = 0 To UBound(a) If IsNumeric(a(i)) Then S = S & a(i) & " " Else a1 = Split(a(i), "-") For II = 0 To a1(1) - a1(0) S = S & a1(0) + II & " " Next End If Next a = Split(S) Range("C2").Resize(1, UBound(a)) = a End Sub
[/vba]
как вариант, для вашего примера [vba]
Код
Sub bop4yh() Dim a, i&, S$, a1, II& a = Split(Replace(Range("A2"), " ", ""), ",") For i = 0 To UBound(a) If IsNumeric(a(i)) Then S = S & a(i) & " " Else a1 = Split(a(i), "-") For II = 0 To a1(1) - a1(0) S = S & a1(0) + II & " " Next End If Next a = Split(S) Range("C2").Resize(1, UBound(a)) = a End Sub
Sub bop4yh() Dim a, i&, S$, a1, II&, C As Range, K&() With CreateObject("Scripting.Dictionary") For Each C In Selection a = Split(Replace(C, " ", ""), ",") For i = 0 To UBound(a) If IsNumeric(a(i)) Then .Item(Val(a(i))) = "" Else a1 = Split(a(i), "-") For II = 0 To a1(1) - a1(0) .Item(a1(0) + II) = "" Next End If Next Next a = .keys End With If UBound(a) > 0 Then ReDim K(UBound(a)) For i = 0 To UBound(a) K(i) = Application.WorksheetFunction.Small(a, i + 1) Next Range("C2").Resize(1, UBound(K) + 1) = K End If End Sub
[/vba]
Работает с выделенными ячейками.
[vba]
Код
Sub bop4yh() Dim a, i&, S$, a1, II&, C As Range, K&() With CreateObject("Scripting.Dictionary") For Each C In Selection a = Split(Replace(C, " ", ""), ",") For i = 0 To UBound(a) If IsNumeric(a(i)) Then .Item(Val(a(i))) = "" Else a1 = Split(a(i), "-") For II = 0 To a1(1) - a1(0) .Item(a1(0) + II) = "" Next End If Next Next a = .keys End With If UBound(a) > 0 Then ReDim K(UBound(a)) For i = 0 To UBound(a) K(i) = Application.WorksheetFunction.Small(a, i + 1) Next Range("C2").Resize(1, UBound(K) + 1) = K End If End Sub