Доброго вечера уважаемые знатоки. Наверное попрошу о многом.
имеется код который образует новый файл, но слишком большой.(прикрепленный Z-DingDan)
Посоветуйте что делать пожалуйста
Может мой же код, где то образует мину?)) так как после сохранения если открыть файл и очистить в ручную образовавшийся пустые ссылки на ячейки,
в колонке 9. размер файла значительно уменьшается.
но при попытке осуществить это с помощью макросов(ниже приведенной)
размер сохраняется
на всякий случай прикреплюданный шаблонный файл
имеется код который образует новый файл, но слишком большой.(прикрепленный Z-DingDan)
Код |
---|
Private Sub Workbook_Open() ActiveSheet.Paste Selection.ColumnWidth = 7 Columns("C:C").Cut Columns("A:A").Select Selection.Insert Shift:=xlToRight Columns("B:B").Select Selection.Cut Columns("H:H").Select Selection.Insert Shift:=xlToRight Rows("2:2").Select Application.CutCopyMode = False Selection.AutoFilter ActiveSheet.Range("$A$2:$E$10000").AutoFilter Field:=5, Criteria1:="<>" ' Макрос выделения с адресами до последней заполненной ячейки Range("A1", Cells(Rows.Count, 7).End(xlUp)).Select Selection.Copy Sheets("Лист3").Select ActiveSheet.Paste Rows("2:2").Select 'фильтр по цвету Selection.AutoFilter ActiveWorkbook.Worksheets("Лист3").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("Лист3").AutoFilter.Sort.SortFields.Add Key:=Range( _ "C2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Лист3").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A3", Cells(Rows.Count, 7).End(xlUp)).Select Selection.Copy Sheets("sheet1").Select ActiveSheet.Paste Rows("3:3").Select Application.CutCopyMode = False Selection.AutoFilter ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Clear 'сортировака по возрастанию ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Add Key:=Range( _ "A5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Selection.Delete Shift:=xlUp LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Шаг 3: Выбираем следующую строку вниз Cells(LastRow, 2).Offset(1, 0).Select 'пишим нужный текст 'ActiveCell.FormulaR1C1 = "Не набивные и шкуры" LastRow = Cells(Rows.Count, 1).End(xlUp).Row Cells(LastRow, 5).Offset(1, 0).Select 'ActiveCell.FormulaR1C1 = "0" LastRow = Cells(Rows.Count, 1).End(xlUp).Row Cells(LastRow, 1).Offset(2, 0).Select 'проблемный участов вставки 1. Range("I4").Select ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-1]" Range("i4:i" & Cells(Rows.Count, 1).End(xlDown).Row).Formula = [i4].FormulaR1C1 Range("B4", Cells(Rows.Count, 9).End(xlUp)).Select Range("R4").Select ActiveCell.FormulaR1C1 = "=R[1]C[-13]" Range("R4").Select ActiveCell.FormulaR1C1 = "=R[-2]C[-13]" Range("O4:P4").Select Sheets("Лист3").Select Range("E1").Select Selection.Copy Sheets("sheet1").Select Range("O4:P4").Select ActiveSheet.Paste Range("O5:P5").Select ActiveCell.FormulaR1C1 = "=R[-1]C" Range("O6").Select Range("U5:V5").Select ActiveCell.FormulaR1C1 = "=R[-1]C[-6]" Range("U6").Select Range("X4").Select ActiveCell.FormulaR1C1 = "=RC[-6]" Range("X5").Select Range("R5").Select ActiveCell.FormulaR1C1 = "=MID(R[-1]C[-3],1,FIND(""-"",R[-1]C[-3])-1)" Range("R6").Select Application.DisplayAlerts = False Sheets("Лист2").Delete Application.DisplayAlerts = True Application.DisplayAlerts = False Sheets("Лист3").Delete Application.DisplayAlerts = True ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Dingdan-1\" & [O4] & Re & ".xlsm" _ , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False End Sub |
Посоветуйте что делать пожалуйста
Может мой же код, где то образует мину?)) так как после сохранения если открыть файл и очистить в ручную образовавшийся пустые ссылки на ячейки,
в колонке 9. размер файла значительно уменьшается.
но при попытке осуществить это с помощью макросов(ниже приведенной)
Код |
---|
Sheets("sheet1").Select LastRow = Cells(Rows.Count, 4).End(xlUp).Row 'Шаг 3: Выбираем следующую строку вниз Cells(LastRow, 9).Offset(1, 0).Select Range(Selection, Selection.End(xlDown)).Delete |
размер сохраняется
на всякий случай прикреплюданный шаблонный файл
Изменено: aybek04 - 23.09.2021 23:53:45