Еще хотелось бы сказать о следующем. Я счёл цифры типа "25.0", "25.1", "3" - количеством. И, лихо превратив их в числа, отобразил как суммы в сводной таблице. Но, возможно, эти цифры на самом деле являются какими-то текстовыми метками (кодами или еще чем-то) и тут уже ни о каком суммировании (а, значит, и о применении сводной таблицы для их отображения) речи идти не может. Можно почитать подробнее об этой проблеме по ссылке: http://www.sql.ru/forum....-chisel
Что же делать? Возвращаться к словарям и сосредоточенно выстраивать горизонтальный ряд заголовков материалов? Можно так. А можно и иначе.
Я сделал пример с использованием ADO, CopyFromRecordset и SQL-запроса типа TRANSFORM, знакомого по MS Access. Чтобы посмотреть результат, достаточно просто открыть файл в сообщении. Чтобы запустить макрос selectData, необходимо вначале скачать файл и сохранить его на своем компьютере (как всегда требуется при использовании ADODB). Также обращаю внимание, что несколько изменилась процедура parseRawText (теперь parseRawText2).
[vba]
Код
Sub selectData()
Dim rst As Object Set rst = CreateObject("ADODB.Recordset")
'Заголовки Dim i As Integer Dim arrName() As Variant ReDim Preserve arrName(0 To rst.Fields.Count - 1) For i = 0 To rst.Fields.Count - 1 arrName(i) = rst.Fields(i).Name Next i With Range("P1").Resize(1, rst.Fields.Count) .Value = arrName .Font.Bold = True End With
End Sub
Sub parseRawText2() Dim rngSource As Range, c As Range Dim i As Integer, j As Integer Dim arrRow, arrVal, arrOut()
Set rngSource = Range("A2:A3")
ReDim arrOut(1 To rngSource.Cells.Count * 20, 1 To 3)
For Each c In rngSource.Cells arrRow = Split(c, ";") For i = LBound(arrRow) To UBound(arrRow) arrVal = Split(arrRow(i), ":") j = j + 1 arrOut(j, 1) = c.Row arrOut(j, 2) = arrVal(0) arrOut(j, 3) = "'" & arrVal(1) 'ВНИМАНИЕ! здесь поменялось! Next i Next c
With Range("K1").Resize(1, 3) .Value = Array("Row", "Column", "Value") 'и здесь поменялось! .Font.Bold = True End With Range("K2").Resize(j, 3).Value = arrOut End Sub
[/vba]
Еще хотелось бы сказать о следующем. Я счёл цифры типа "25.0", "25.1", "3" - количеством. И, лихо превратив их в числа, отобразил как суммы в сводной таблице. Но, возможно, эти цифры на самом деле являются какими-то текстовыми метками (кодами или еще чем-то) и тут уже ни о каком суммировании (а, значит, и о применении сводной таблицы для их отображения) речи идти не может. Можно почитать подробнее об этой проблеме по ссылке: http://www.sql.ru/forum....-chisel
Что же делать? Возвращаться к словарям и сосредоточенно выстраивать горизонтальный ряд заголовков материалов? Можно так. А можно и иначе.
Я сделал пример с использованием ADO, CopyFromRecordset и SQL-запроса типа TRANSFORM, знакомого по MS Access. Чтобы посмотреть результат, достаточно просто открыть файл в сообщении. Чтобы запустить макрос selectData, необходимо вначале скачать файл и сохранить его на своем компьютере (как всегда требуется при использовании ADODB). Также обращаю внимание, что несколько изменилась процедура parseRawText (теперь parseRawText2).
[vba]
Код
Sub selectData()
Dim rst As Object Set rst = CreateObject("ADODB.Recordset")
'Заголовки Dim i As Integer Dim arrName() As Variant ReDim Preserve arrName(0 To rst.Fields.Count - 1) For i = 0 To rst.Fields.Count - 1 arrName(i) = rst.Fields(i).Name Next i With Range("P1").Resize(1, rst.Fields.Count) .Value = arrName .Font.Bold = True End With
End Sub
Sub parseRawText2() Dim rngSource As Range, c As Range Dim i As Integer, j As Integer Dim arrRow, arrVal, arrOut()
Set rngSource = Range("A2:A3")
ReDim arrOut(1 To rngSource.Cells.Count * 20, 1 To 3)
For Each c In rngSource.Cells arrRow = Split(c, ";") For i = LBound(arrRow) To UBound(arrRow) arrVal = Split(arrRow(i), ":") j = j + 1 arrOut(j, 1) = c.Row arrOut(j, 2) = arrVal(0) arrOut(j, 3) = "'" & arrVal(1) 'ВНИМАНИЕ! здесь поменялось! Next i Next c
With Range("K1").Resize(1, 3) .Value = Array("Row", "Column", "Value") 'и здесь поменялось! .Font.Bold = True End With Range("K2").Resize(j, 3).Value = arrOut End Sub