Ребята, help!!! Ситуэйшен требует руки профессионала! Макрос запилил насколько смог.
Имеется исходный файл: "Журнал регистрации". В нем 6 форм(на самом деле 11 - макс размер файла 100 кб поэтому удалил). При запуске заполняются формы.
Наполнение ячейки зависит от тега в квадратных скобках. Значение в квадратных скобках соответствует строка-активная ячейка, столбец- пронумерованные ячейки из 5 строки.
Что необходимо сделать: 1) Ячейки в определенных частях имеют многострочный формат, т.е. изначально ячейка была одна(объединенная) и в частях с 55 по 62 и с 90 по 154 они уже не объединены. Теги сейчас вставлены внутрь ячейки. И вот по этим тегам информация должна попадать в формы.
2) Нужно сделать так. чтобы формы с 1 по 11 сохранялись в какой-нибудь директории.
Код:
Вышеописанный принцип работы - это моё видение. Допускаю, что можно сделать все иначе. Понимаю, что задача непростая, поэтому и обращаюсь на форум.
Кнопка оформления кода[B] <...>
Рисунок удален: превышение допустимого размера вложения.
Тема переименована: один вопрос - одна тема [МОДЕРАТОР]
Имеется исходный файл: "Журнал регистрации". В нем 6 форм(на самом деле 11 - макс размер файла 100 кб поэтому удалил). При запуске заполняются формы.
Наполнение ячейки зависит от тега в квадратных скобках. Значение в квадратных скобках соответствует строка-активная ячейка, столбец- пронумерованные ячейки из 5 строки.
Что необходимо сделать: 1) Ячейки в определенных частях имеют многострочный формат, т.е. изначально ячейка была одна(объединенная) и в частях с 55 по 62 и с 90 по 154 они уже не объединены. Теги сейчас вставлены внутрь ячейки. И вот по этим тегам информация должна попадать в формы.
2) Нужно сделать так. чтобы формы с 1 по 11 сохранялись в какой-нибудь директории.
Код:
Код |
---|
Const xLen = 154 Const yTitle = 4 Const stName = "Журнал регистрации" Sub test() 'Dim stSheet As Sheet ' y0 = ActiveCell.Row x0 = ActiveCell.Column 'Set stSheet = ThisWorkbook.Sheets("Журнал регистрации") ' ar = Application.Transpose(Application.Transpose(Range(Cells(yTitle, 1), Cells(yTitle, 154)))) For Each x In ThisWorkbook.Worksheets If Left(x.Name, 5) = "Форма" Then For i = 1 To 100 For j = 1 To 150 s = x.Cells(j, i).Value If Left(s, 1) = "[" Then s2 = Trim(Mid(s, 2, Len(s) - 2)) 'x.Cells(j, i).Value = ar(Mid(x.Cells(j, i).Value, 2, Len(x.Cells(j, i).Value) - 1)) k = 1 While (Trim(ar(k)) <> s2) And (k < xLen) k = k + 1 Wend MsgBox k sF = ThisWorkbook.Sheets(stName).Cells(y0, k).Value x.Cells(j, i).Value = sF End If Next Next End If Next x ' End Sub |
Вышеописанный принцип работы - это моё видение. Допускаю, что можно сделать все иначе. Понимаю, что задача непростая, поэтому и обращаюсь на форум.
Кнопка оформления кода[B] <...>
Рисунок удален: превышение допустимого размера вложения.
Тема переименована: один вопрос - одна тема [МОДЕРАТОР]