|
Окей! Задача целиком и полность, потому, что я устала уже сама колупаться :( Программа bCAD Exel файл его нужно привести к необходимому виду... Для этого нужно найти ячеки с определенным текстом(несколько ячеек 3-7 на в среднем) выделить жирным текстом, перенести вправо, добавить сверху пустую строку. Если текст не найден - сообщить об этом, но не обо всех, а только об одном(который я часто забываю добавить). потом все полученное обвести рамкой внутри и снаружи.
И еще добавть формулу которая будут перемножать содержимое двух столбцов, но не во все подряд, а если в строках по этим столбцам ячейки не пустые, если пустые то соответственно формулу вставлять не надо.
То есть в B и D есть числа, но только в строках 1 и 3, соответственно в C1 и С3 должна появиться формула перемножающая B и D, а C2 останеться пустой так как в B2 и D2 чисел нет.
A B C D
1
2
3
Ничего из этого я сделать не могу...
То есть вот код:
Attribute VB_Name = "Module1"
Sub Смета()
'
' Макрос5 Макрос
' Макрос записан 14.07.2005 (Konstruktor)
'
'Материалы основы
On Error GoTo V
Cells.Find(What:="Панели: Материалы основы", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Font.Bold = True
Selection.Cut
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveSheet.Paste
Selection.EntireRow.Insert
' Материалы кромок
R1: Resume n
n: On Error GoTo V1
Cells.Find(What:="Панели: Материалы кромок", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Font.Bold = True
Selection.Cut
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveSheet.Paste
Selection.EntireRow.Insert
' Крепеж
R2: Resume n1
n1: On Error GoTo V2
Cells.Find(What:="Крепёж", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Font.Bold = True
Selection.Cut
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveSheet.Paste
Selection.EntireRow.Insert
'Вспомогательные материалы
R3: Resume n2
n2: On Error GoTo V3
Cells.Find(What:="Вспомогательные материалы", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Font.Bold = True
Selection.Cut
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveSheet.Paste
Selection.EntireRow.Insert
'Профили
R4: Resume n3
n3: On Error GoTo V4
Cells.Find(What:="Профили: Материалы основы", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Font.Bold = True
Selection.Cut
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveSheet.Paste
Selection.EntireRow.Insert
GoTo R5
V: MsgBox "В проекте отсутстуют Панели: Материалы основы"
GoTo R1
V1: MsgBox "В проекте отсутстуют Панели: Материалы кромок"
GoTo R2
V2: MsgBox "В проекте отсутствует Крепёж"
GoTo R3
V3: MsgBox "В проекте отсутстуют Вспомогательные материалы"
GoTo R4
V4: MsgBox "В проекте отсутстуют Профили: Материалы основы"
GoTo R5
' Удаление и перемещение ненужных столбцов
R5: Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("D:D").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Range("D1").Select
ActiveCell.FormulaR1C1 = "Цена"
Range("E1").Select
Cells.Select
Cells.EntireColumn.AutoFit
End Sub
Попробуйте ради интереса запустить и увидите как все глючит, то есть выводит сообщение о том что материала нет, если нет слудующего :( Кароче все стремно, криво и мне жутко обидно %(
|
