Изменил последний вариант Вашей таблицы, придумал немного другой файл с данными.
Смысл этого извращения мне до сих пор непонятен
[spoiler]Это скрипт[/spoiler]
[spoiler]
Код: Выделить всё
FileIn = "Z:\Soft_In\Мой Пример.cfg"
FileOut = "Z:\Soft_In\Мой Пример.xls"
Con = Array("B", "C") 'В этих столбцах записываются заголовки блоков
Dan = Array("D", "E", "G", "H") 'В этих столбцах записываются данные
Str1 = 5 'В этой строке первое данное
NoNull = "E" 'В этом столбце обязательно должны быть данные
Form = Array("F") 'В этих столбцах формулы. В первой строке с данными они должны быть
Beg = "#" 'Признак начала секции
Delim = ";" 'Разделитель данных
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fIn = FSO.OpenTextFile(FileIn, 1, False)
If Err.Number <> 0 Then
MsgBox "File " + FileIn + vbCrLf + Err.Description + "(" + CStr(Err.Number) + ")"
WScript.Quit 2
End If
On Error GoTo 0
Alls = Split(fIn.ReadAll, vbCrLf)
fIn.Close
With CreateObject("Excel.Application")
.Visible = True
.Workbooks.Open FileOut
i = Str1
Do
If Trim(.Range(NoNull + CStr(i))) = "" Then
Exit Do
End If
i = i + 1
Loop
NCon = UBound(Con)
NDan = UBound(Dan)
LBegin = False
For Each j In Alls
If Not Trim(j) = "" Then
If Left(j, 1) = Beg Then
If LBegin Then
For Each m In Con
.Range(m + CStr(i1) + ":" + m + CStr(i2 - 1)).Merge
Next
End If
LBegin = True
i1 = i
i2 = i
jCon = Split(j, Delim)
jj = 0
For Each k In jCon
If jj <= NCon Then
.Range(Con(jj) + CStr(i1)) = Replace(k, Beg, "")
End If
jj = jj + 1
Next
Else
If LBegin Then
jCon = Split(j, Delim)
jj = 0
For Each k In jCon
If jj <= NDan Then
.Range(Dan(jj) + CStr(i2)) = k
End If
jj = jj + 1
Next
For Each k In Form
.Range(k + CStr(Str1)).Copy
.Range(k + CStr(i)).PasteSpecial -4123
Next
i = i + 1
i2 = i
End If
End If
End If
Next
If LBegin Then
For Each m In Con
.Range(m + CStr(i1) + ":" + m + CStr(i2 - 1)).Merge
Next
End If
.ActiveWorkbook.Save
.ActiveWorkbook.Close
.Quit
End WithЭто файл с данными
[spoiler]
Код: Выделить всё
#Для тех, кто в танке;куб. градусы
1;огонь;13;4
2;вода;6;7
3;медные трубы;14;6
#Для страуса;зиверты
5;песок;8;5
6;цемент;9;6
7;плитка;10;7
#Ритуальные услуги;кв.литры
9;краска;4;6
10;грунтовка;8;7
11;шпатлевка;13;5Распакуйте архив, пропишите в скрипте свои пути. Посмотрите на Excel-файл до и после скрипта.
Это пример того, что сделать можно что угодно, но не думаю, что практически он полезен - мутная постановка с непонятным смыслом.
Если захотите изменить таблицу, в скрипте есть настройки сверху на уровне входных данных (с комментариями).
- Вложения