| 0
- 14.01.2012 - 16:45
|
Имеется чертеж с неопределенном наборов блоков с атрибутами. Один из ключчевых атрибутов имеет имя "Номер". После извлечения занчений атрибутов получается внешний файл XLS содержащий значения атрибутов. Для того что бы получилась готовая спецификация я использую макрос, который мне помог написать один из великих гуру Этот макрос сортирует значения в поле "НОМЕР" по возрастанию, а данные в столбце "НАИМЕНОВАНИЕ" сравнивает с длинной ячейки, если текст больше фиксированной длины - добавляет новую строку ниже и перемещает туда остаток текста. Затем сравнивает два соседних значения в поле "НОМЕР" и если первый символ отличается - добавляет между ними пустую строку (номер раньше обязательно указывался по тиму М-4, М-5, С-2, С-41 и т.д. тоесть всегда присутсвовала буква, затем разделитель а потом цифра). теперь хочеться усовершенствовать процесс. В поле "НОМЕР" теперь будут только цифровые значения, в поле "ПРИМЕЧАНИЕ" Будет указываться русское название помещения и его номер в экспликации например "Кладовая суточного запаса продуктов - 135" здесь минус означает что помещение находиться в цоколе или подвале. Каждый блок на плане будет содержать информацию о том, к какому помещению он пренадлежит. Нумерация блоков будет начинаться с 1 для каждого нового помещения. После извлечения инфы получиться (см. вложение) далее сортировку производить теперь не только по "номеру" а еще и по "ПРИМЕЧАНИЕ" Точнее так - сначала сортировка всех строк по значению ячеек столбца "ПРИМЕЧАНИЕ", затем добавление 2-х пустых строк между разными значениями соседних ячеек столбца "ПРИМЕЧАНИЕ" (выделяем диапазон значений который принадлежит определенным помещениям или помещению) затем идет сортировка внутри каждого диапазона отдельно независимо от других (сто бы случайно не перемешатьт все в кучу) После сортировки в верхнюю строку (перед диапазоном) в ячейку "наименование" переноситься значение ячейки столбца "ПРИМЕЧАНИЕ" принадлежащее этому же самому диапазону. Далее все значения столбца "ПРИМЕЧАНИЕ" нужно удалить. Да кстати можно название помещения начинать с номера экспликации а потом уже само наименование сюда файлы прикрепить нельзя поэтому даю ссылку http://forum.dwg.ru/showthread.php?p=861581#post861581     | |
| 1
- 14.01.2012 - 17:34
|
'В цикле сравниваем текст соседних ячеек столбца "9" до знака " " (пробел) и при несовпедении 'добавляем пустую строку. Т.е. разделяем группы с одинаковыми буквами. On Error Resume Next For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Split(Cells(i, 9), " ")(0) <> Split(Cells(i + 1, 9), " ")(0) Then Rows(i + 1).Insert.Then Rows(i + 1).Insert Next 'цифра 9 в скобках указывает здесь на номер столбца ' Теперь нужно придумать как копировать текст ячейки с названием помещения в ячейку "наименование" ? вопрос не решен | |
| 2
- 14.01.2012 - 18:31
|
ладно, давайте пошагово : идет сравнение ячейки (строки i, ряда 9) с ячейкой (строки i+1, ряда 9) теперь нужно указать команду, что бы значение ячейки (i,9) скопировалось в ячейку (i-1, ряда 2) я записал так: For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Split(Cells(i, 9), " ")(0) <> Split(Cells(i + 1, 9), " ")(0) Then Rows(i + 1).Insert.Then Rows(i + 1).Insert Cells(i, 9).Copy Cells(i - 1, 2).Paste Next но вставляются значения не в одну а во все ячейки строки (i-1) хотя указан номер столбца (2) что не так? | |
| 3
- 14.01.2012 - 21:53
|
очень странный способ работы с ячейками зачем делать инсерт ряда? зачем делать копи пэйст если можно написать Cells(i - 1, 2)=Cells(i, 9) | |
| 4
- 15.01.2012 - 09:59
|
4-vxg > Ну наконе ц то )) хоть кто-то отзвался а то на двух форумах задал вопрос а ответа нет ну во первых я просто не знаю как грамотно написать но мне нужно сейчас добавить две пустые строки между отличными друг от друга ячейками столбца №9 Then Rows(i + 1).Insert. так добавляю одну строку и затем еще одну. теперь после добавления строк мне целый столбец не нужен а нужно только перенести или скопировать значение нижней (отличной) ячейки в ячейку второго столбца на одну строку выше | |
| 5
- 16.01.2012 - 08:54
| вы перебираете строчки от последнего до первого и при этом вставляете новые - я таких фокусов стараюсь избегать - что мешает вам воспринимать один лист книги как входные данные, а второй - как результат. проходите по строкам первого листа и при определенных вами условиях копируете (возможно с модификацией) данные на второй лист. если для книги критично наличие именно одного листа, то лист входных данных в конце можно удалить. само по себе присваивание содержимого одной ячейки другой должно работать, если вы наблюдаете чудеса - дело в другом. я бы на вашем месте глядел в строну "нормализации" проекта | |
| 6
- 16.01.2012 - 19:59
|
посмотрите ссылку - я просто приложил файлик "итог" там уже подвязан лист @summary@ он и есть как входные данные, лист "промежуточный нужен только для копирования результата редактирования входных данных а лист "спецификация ссылается на промежуточный. Там все сейчас работает и я не хочу глобально изменять процедуру создания спецификации потому что в файле итог очень много настроек которые нужно будет заново восстанавливать... кроме этого есть исходный файл (совсем другой ) который генерирует автокад во время выборки информации из блоков но он используется просто для переноса информации из автокада в файл "итоговый/xls" Я не понимаю как нужно написать код правильно что бы данные из ячейки переносильсь в нужную... в остальном все работает нормально далее еще есть задачи но о них позже | |
| 7
- 17.01.2012 - 08:39
|
человек писавший макрос использовал незнакомый мне стиль поэтому воткнуть в смысл мне оказалось сложнее чем написать вот что то такое Option Explicit Public Sub proc() Dim s As String Dim i As Integer Dim i_dst As Integer Dim j As Integer Dim c As Integer Dim prev_comment As String 'копируем шапку и одновременно считаем количество столбцов таблицы i = 1 c = 0 Do While True s = Worksheets(1).Cells(1, i) If s = "" Then Exit Do 'счтитаем что шапка не имеет разрывов Worksheets(2).Cells(1, i) = s i = i + 1 c = c + 1 Loop 'формируем таблицу i = 2 i_dst = 2 Do While True s = Worksheets(1).Cells(i, 1) If s = "" Then Exit Do 'считаем что таблица не имеет разрывов If Worksheets(1).Cells(i, 9) <> prev_comment Then 'если примечание изменилось, то... prev_comment = Worksheets(1).Cells(i, 9) 'обновляем "текущее" примечание 'вставляем пустую строку i_dst = i_dst + 1 'вставляем строку с примечанием Worksheets(2).Cells(i_dst, 2) = Worksheets(1).Cells(i, 9) i_dst = i_dst + 1 End If 'копируем строку For j = 1 To c Worksheets(2).Cells(i_dst, j) = Worksheets(1).Cells(i, j) Next i = i + 1 i_dst = i_dst + 1 Loop End Sub | |
| 8
- 24.01.2012 - 07:43
|
8-vxg > Ого ... интересно ... я еще не переварил ))) Особенно понравилось про "если примечание изменилось" Спасибо! ща буду пытаться внедрять | |
Интернет-форум Краснодарского края и Краснодара |
