Developing.ru

Код: Выделить всё

[color=darkblue]Private[/color] [color=darkblue]Declare[/color] [color=darkblue]Sub[/color] CopyMemory [color=darkblue]Lib[/color] "kernel32.dll" Alias "RtlMoveMemory" _
   ([color=darkblue]ByRef[/color] Destination [color=darkblue]As[/color] Any, [color=darkblue]ByRef[/color] Source [color=darkblue]As[/color] Any, [color=darkblue]ByVal[/color] Length [color=darkblue]As[/color] [color=darkblue]Long[/color])

Код: Выделить всё

[color=Navy]  Option Explicit
  Option Base 0
[/color][color=Lime]'...[/color]
  [color=darkblue]Dim [color=black]a1()[/color] As String
  Dim [color=black]n[/color] As Long
  Dim [color=black]s[/color] As String
  [color=black]s =[/color] [color=DarkGreen][B]"Аспирин - 100 уп."[/B][/color] [color=Black]&[/color] vbLf [color=Black]&[/color] [B][color=DarkGreen]"Анальгин - 280 уп."[/color][/B] [color=Black]&[/color] vbLf [color=Black]&[/color] [B][color=DarkGreen]"Димедрол - 80 уп."[/color][/B]
  [color=Lime]'формируем одномерный массив[/color]
  [color=Black]s =[/color] Replace[color=Black](s[/color], [B][color=DarkGreen]" - "[/color][/B], vbLf[color=Black])[/color]
  [color=Black]a1[/color] = Split[color=Black](s[/color], vbLf[color=Black])[/color]
  [color=Black]n = [/color]UBound([color=Black]a1[/color]) [color=Black]+ 1[/color]
  If [color=Black]n / 2 <> n \ 2[/color] Then [color=Lime]' нечётное число элементов ?[/color]
       MsgBox [color=DarkGreen][B]"Неверный формат исходных данных"[/B][/color]
  End If
  [color=Lime]'определяем 2-х мерный массив[/color]
  ReDim [color=Black]a2[/color]([color=Black]1[/color] To [color=Black]2[/color], [color=Black]1[/color] To [color=Black]n / 2[/color]) As String
  [color=Lime]'копируем указатели на элементы массива[/color]
  [color=Black][color=Navy]Call[/color] CopyMemory([/color]ByVal VarPtr[color=Black](a2(1, 1))[/color], ByVal VarPtr[color=Black](a1(0)), n * 4)
  [color=Lime]'транспонируем матрицу и заполняем 2-х колоночный ListBox[/color]
[/color]  [color=Black] UserForm1.ListBox1.[/color]List[color=Black]()[/color] = Application.WorksheetFunction[color=black].[/color]Transpose[color=Black](a2)[/color]
[/color]

Код: Выделить всё

Sub Main()
    Dim a, b()
    a = Split([A1], Chr(10)): ReDim b(1 To UBound(a) + 1, 1 To 2)
    For i = LBound(a) To UBound(a)
        b(i + 1, 1) = Trim(Split(a(i), "-")(0)): b(i + 1, 2) = Trim(Split(a(i), "-")(1))
    Next
End Sub