Получаю данные о заказе с сайта в формате сериализованой PHP строки:
Скрытый текст
a:9:{i:0;a:24:{s:2:"id";i:8561;s:15:"product_type_id";i:1;s:5:"title";s:67:"Манетка Shimano Tourney, SL-RS35, 6 ск, трос 2050 мм";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"17.00";s:3:"qty";i:9;s:9:"qty_delta";i:0;s:11:"description";s:735:"<p><br></p><p>Шифтер Tourney от фирмы Shimano, начального уровня. Бюджетный, но качественный. Рассчитан на 6 скоростей, длина троса - 2050 мм. Модель в основном ориентирована на велосипеды для детей и подростков. В данной модели манетка является продолжением грипсы, соединяясь с ней, благодаря чему ребенок имеет возможность переключить передачу не отпуская рук. Черного цвета. Вес: 208 грамм. С индикатором скоростей.</p>";s:15:"manufacturer_id";i:2;s:7:"artikul";s:11:"ESLRS35R6AP";s:7:"barcode";s:13:"4524667337935";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1468320567;s:10:"updated_at";i:1555710070;s:4:"c_id";i:1006692;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:1;a:24:{s:2:"id";i:5597;s:15:"product_type_id";i:1;s:5:"title";s:53:"Покрышка 26" x 2,0 (50-559) K878 KRISP, KENDA";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"26.00";s:3:"qty";i:6;s:9:"qty_delta";i:0;s:11:"description";s:835:"<p> <br></p><p><span class="redactor-invisible-space">Полуслик, сочетает хороший накат на асфальте благодаря невысокому</span> основному протектору и стабильности при поворотах и на вязкой дороге, благодаря расширенной форме боковых грунтозацепов. Мелкая шероховатость по центру резины, обеспечивают отличное сцепление и на сухом, и на мокром покрытии. Прекрасный выбор протектора для города<span class="redactor-invisible-space"> и небольших поездок по бездорожью. Рекомендуется для </span> CYCLO CROSS</p>";s:15:"manufacturer_id";i:5;s:7:"artikul";s:8:"5-527711";s:7:"barcode";s:13:"2000010072002";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1468320331;s:10:"updated_at";i:1556089272;s:4:"c_id";i:1007200;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:2;a:24:{s:2:"id";i:16082;s:15:"product_type_id";i:1;s:5:"title";s:56:"Ролики для Shimano Tourney, TX35, 13T, 6/7 ск";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"17.00";s:3:"qty";i:3;s:9:"qty_delta";i:0;s:11:"description";s:558:"<p>Оригинальные ролики для заднего переключателя Shimano Tournty.</p><p>Комплект состоит из двух роликов - верхнего и нижнего.</p><ul><li>Собраны на втулках скольжения;</li><li>Количество зубъев на каждом - 13T;</li><li>Изготовлены из высококачественного пластика;</li><li>Совместимость с переключателями Shimano: RD-TX35 / RD-TX55 / RD-M280 / </li></ul>";s:15:"manufacturer_id";i:2;s:7:"artikul";s:9:"Y5WS98030";s:7:"barcode";s:13:"4524667609704";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1490107257;s:10:"updated_at";i:1556089273;s:4:"c_id";i:1007901;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:3;a:24:{s:2:"id";i:8669;s:15:"product_type_id";i:1;s:5:"title";s:66:"Шатуны HDL-P303 24/34/42Т,170мм сталь/пластик";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"22.00";s:3:"qty";i:4;s:9:"qty_delta";i:0;s:11:"description";s:0:"";s:15:"manufacturer_id";i:5;s:7:"artikul";s:6:"580235";s:7:"barcode";s:13:"2000010066865";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1468320576;s:10:"updated_at";i:1556089274;s:4:"c_id";i:1006686;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:4;a:24:{s:2:"id";i:18401;s:15:"product_type_id";i:1;s:5:"title";s:31:"Цепь YBN S50-S1 (6-7 speed)";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"13.00";s:3:"qty";i:1;s:9:"qty_delta";i:0;s:11:"description";s:715:"<p>B индивидуальной упаковке YBN BOX<br>Количество звеньев: 114<br>Размер: 1/2"*3/32"<br>Speed: 6 ~ 7 <br>Замок цепи: Single Pin (7,3 мм)</p>";s:15:"manufacturer_id";i:16;s:7:"artikul";s:4:"3646";s:7:"barcode";s:13:"4710887191314";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1490107261;s:10:"updated_at";i:1556089274;s:4:"c_id";i:1008052;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:5;a:24:{s:2:"id";i:30406061;s:15:"product_type_id";i:1;s:5:"title";s:56:"Трещотка Shimano Tourney, MF-TZ500, 7ск, 14-28";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"25.00";s:3:"qty";i:92;s:9:"qty_delta";i:0;s:11:"description";s:0:"";s:15:"manufacturer_id";i:5;s:7:"artikul";s:12:"AMFTZ5007428";s:7:"barcode";s:13:"2000010102372";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1525958826;s:10:"updated_at";i:1556089273;s:4:"c_id";i:1010237;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:6;a:24:{s:2:"id";i:7527;s:15:"product_type_id";i:1;s:5:"title";s:99:"Торм. колодки Shimano, для диск т. BRT615, B01S, пласт., c шплинтом";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"23.00";s:3:"qty";i:19;s:9:"qty_delta";i:0;s:11:"description";s:0:"";s:15:"manufacturer_id";i:2;s:7:"artikul";s:0:"";s:7:"barcode";s:13:"4524667737001";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1468320487;s:10:"updated_at";i:1556089273;s:4:"c_id";i:1006350;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:7;a:24:{s:2:"id";i:31162776;s:15:"product_type_id";i:1;s:5:"title";s:97:"Тормозные колодки RB-D26 SEMI-METAL (DSK-310/715/720/717/913(Decipher), Avid BB5)";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"12.00";s:3:"qty";i:16;s:9:"qty_delta";i:0;s:11:"description";N;s:15:"manufacturer_id";N;s:7:"artikul";s:0:"";s:7:"barcode";s:13:"2000010111398";s:4:"unit";s:5:"шт.";s:10:"created_at";i:1530681846;s:10:"updated_at";i:1556089273;s:4:"c_id";i:1011139;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}i:8;a:24:{s:2:"id";i:2980;s:15:"product_type_id";i:1;s:5:"title";s:64:"Каретка Shimano, UN26, 68x117,5 мм, без болтов";s:6:"status";i:1;s:8:"featured";i:0;s:8:"discount";i:0;s:13:"lock_discount";i:0;s:5:"price";s:5:"29.00";s:3:"qty";i:13;s:9:"qty_delta";i:0;s:11:"description";s:592:"<p>Квадрат - старый, но не изживший себя стандарт, дешевый, достаточно надежный и простой в эксплуатации.</p><p>Каретка Shimano UN26 имеет различные варианты длины вала и диаметра.</p><p>Технические характеристики:</p><p>Назначение: MTB, город, шоссе</p><p>Левая чашка: пластик</p><p>Правая чашка: Фосфатированная сталь </p><p>Тип каретки: Квадрат</p>";s:15:"manufacturer_id";i:2;s:7:"artikul";s:11:"EBBUN26B17X";s:7:"barcode";s:13:"4524667089636";s:4:"unit";s:0:"";s:10:"created_at";i:1468320043;s:10:"updated_at";i:1556089270;s:4:"c_id";i:4078;s:7:"special";i:0;s:7:"popular";i:0;s:3:"new";i:0;s:12:"availability";i:2;s:12:"new_set_date";N;s:8:"quantity";i:1;}}
Public Function unserialize(ByVal str As String) As Variant
Dim retval() As Variant, Index As Integer, i As Integer, inpdata As String
inpdata = str
' Checks used split character for Decimal (depends from country, dot or comma)
'Dim commaused As Boolean
'If CStr(CDec("5.44")) = "544" Then
' commaused = True
'Else
' commaused = False
'End If
' Used at String, Integer, Array
Dim nr As String, b As String
' Used at Array
Dim arraydata As String, arrayend As Boolean, arraydepth As Integer, initstate As Boolean
If Len(inpdata) > 32767 Then
' Data may not be longer then 32767 characters. Otherwise it will raise an overflow error
Error 6
End If
i = 0
Do
i = i + 1
Select Case UCase(Mid(inpdata, i, 1))
Case "A" ' Array pointer (in this routine called Subarray)
' New value in array
If UCase(Mid(inpdata, i + 1, 1)) <> ":" Then
i = i + 1
Else
Index = Index + 1: ReDim Preserve retval(1 To Index)
Do ' Loops until next { to get to the array start, I don't parse the value count, since it's not required data
i = i + 1
b = Mid(inpdata, i, 1)
If b <> "{" Then nr = nr & b
Loop Until b = "{" Or i >= Len(inpdata)
arraydata = "": b = "": arrayend = False: initstate = True
Do ' Loops until array is ended
i = i + 1
b = Mid(inpdata, i, 1)
arraydata = arraydata & b
' Checks for strings
If initstate Then
If UCase(b) = "S" Then ' String in subarray, can contain } so be careful
i = i + 1: arraydata = arraydata & ":" ' Expects a : right after the string-declaration
' Almost exact copy of string functionality
nr = "": b = ""
Do ' Loops until next : to get the string length
i = i + 1
b = Mid(inpdata, i, 1)
arraydata = arraydata & b
If b <> ":" Then nr = nr & b
Loop Until b = ":" Or i >= Len(inpdata)
arraydata = arraydata & Chr(34) & Mid(inpdata, i + 2, Val(nr)) & Chr(34) & ";"
i = i + Val(nr) + 3 ' 3 = two times " and one time ;
End If
initstate = False
Else
If b = ";" Then initstate = True
End If
' Subsub arrays will be handled here
If b = "{" Then arraydepth = arraydepth + 1
If b = "}" Then
If arraydepth = 0 Then arrayend = True Else arraydepth = arraydepth - 1
End If
If i >= Len(inpdata) Then arrayend = True ' Exeption
Loop Until arrayend
arraydata = Left(arraydata, Len(arraydata) - 1) ' Removes last }
retval(Index) = unserialize(arraydata)
End If
Case "S" ' String pointer
' New value in array
If UCase(Mid(inpdata, i + 1, 1)) <> ":" Then
i = i + 1
Else
Index = Index + 1: ReDim Preserve retval(1 To Index)
i = i + 1 ' Expects a : right after the string-declaration
nr = "": b = ""
Do ' Loops until next : to get the string length
i = i + 1
b = Mid(inpdata, i, 1)
If b <> ":" Then nr = nr & b
Loop Until b = ":" Or i >= Len(inpdata)
If retval(Index) = "title" Then nr = nr - 15 'Здесь исправление ошибки при записи заказа с сайта
retval(Index) = Mid(inpdata, i + 2, Val(nr))
i = i + Val(nr) + 3 ' 3 = two times " and one time ;
End If
Case "B" ' Boolean pointer
' New value in array
If UCase(Mid(inpdata, i + 1, 1)) <> ":" Then
i = i + 1
Else
Index = Index + 1: ReDim Preserve retval(1 To Index)
i = i + 1 ' Expects a : right after the boolean-declaration
i = i + 1 ' Boolean-value itself
If Mid(inpdata, i, 1) = "1" Then retval(Index) = True Else retval(Index) = False
i = i + 1 ' Expects a ; right after the boolean-value
End If
Case "I" ' Integer pointer
' New value in array
If UCase(Mid(inpdata, i + 1, 1)) <> ":" Then
i = i + 1
Else
Index = Index + 1: ReDim Preserve retval(1 To Index)
i = i + 1 ' Expects a : right after the integer-declaration
nr = "": b = ""
Do ' Loops until next ; to get the string length
i = i + 1
b = Mid(inpdata, i, 1)
If b <> ";" Then nr = nr & b
Loop Until b = ";" Or i >= Len(inpdata)
retval(Index) = CLng(nr)
End If
Case "D" ' Double pointer
' New value in array
If UCase(Mid(inpdata, i + 1, 1)) <> ":" Then
i = i + 1
Else
Index = Index + 1: ReDim Preserve retval(1 To Index)
i = i + 1 ' Expects a : right after the double-declaration
nr = "": b = ""
Do ' Loops until next ; to get the string length
i = i + 1
b = Mid(inpdata, i, 1)
If b <> ";" Then nr = nr & b
Loop Until b = ";" Or i >= Len(inpdata)
If commaused Then nr = Replace(nr, ".", ",")
retval(Index) = CDec(nr)
End If
Case "N" ' Null pointer
' New value in array
If UCase(Mid(inpdata, i + 1, 1)) <> ":" Then
i = i + 1
Else
Index = Index + 1: ReDim Preserve retval(1 To Index)
retval(Index) = Null
i = i + 1 ' Expects a ; at the end of the Null
End If
'Case Else
' The string contains unparsable values
'Error 93
End Select
Loop Until i >= Len(inpdata)
unserialize = retval
End Function
Помогите извлечь данные средствами VBA в формате прикрепленного изображения
Sub qwert() Dim s, a, f f = ActiveWorkbook.Path & "\test.txt" a = CreateObject("Scripting.FileSystemObject").OpenTextFile(f, 1).ReadAll qwerty a End Sub
Sub qwerty(s)
Dim r, i, u, uu, c, zag: sag = Split(",title,barcode,quantity,price,discount", ",")
Dim rz(), t
u = Split(s, "{s")
ReDim rz(UBound(u), 1 To 5)
For c = 1 To UBound(sag)
rz(0, c) = sag
Next c
For r = 1 To UBound(u)
i = i + 1
ui = u(i)
uu = Split(ui, ";")
i1 = 0
For c = 1 To UBound(uu)
uui = uu(i1)
If InStr(1, uui, "title", vbTextCompare) > 0 Then
i2 = i1 + 1
uui = uu(i2)
t = Split(uui, ":")
rz(r, 1) = t(UBound(t))
End If
If InStr(1, uui, "barcode", vbTextCompare) > 0 Then
i2 = i1 + 1
uui = uu(i2)
t = Split(uui, ":")
rz(r, 2) = t(UBound(t))
End If
If InStr(1, uui, "quantity", vbTextCompare) > 0 Then
i2 = i1 + 1
uui = uu(i2)
t = Split(uui, ":")
rz(r, 3) = t(UBound(t))
End If
If InStr(1, uui, "price", vbTextCompare) > 0 Then
i2 = i1 + 1
uui = uu(i2)
t = Split(uui, ":")
rz(r, 4) = t(UBound(t))
End If
If InStr(1, uui, "discount", vbTextCompare) > 0 Then
i2 = i1 + 1
uui = uu(i2)
t = Split(uui, ":")
rz(r, 5) = t(UBound(t))
End If
i1 = i1 + 1
Next c
Next r
Sheets(3).Cells(12, 1).Resize(UBound(rz) + 1, UBound(rz, 2)) = rz
Sheets(3).Cells(12, 1).Resize(UBound(rz) + 1, UBound(rz, 2)).Columns.AutoFit
End Sub