Sub ttt() Dim tut& tut = Cells(1, Columns.Count).End(xlToLeft).Column For i = tut To 1 Step -1 If Cells(6, i) = "" Then Columns(i).Delete End If Next i End Sub
[/vba] [p.s.]только не пробуйте на реальном файле. действие макроса не отменить
без файла только так [vba]
Код
Sub ttt() Dim tut& tut = Cells(1, Columns.Count).End(xlToLeft).Column For i = tut To 1 Step -1 If Cells(6, i) = "" Then Columns(i).Delete End If Next i End Sub
[/vba] [p.s.]только не пробуйте на реальном файле. действие макроса не отменитькитин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Сообщение отредактировал китин - Вторник, 10.07.2018, 15:18
Sub tt() c_ = Cells(1).SpecialCells(xlLastCell).Column r_ = Cells(1).SpecialCells(xlLastCell).Row r0_ = 5 Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual If r_ <= r0_ Then Cells(1).Resize(1, c_).EntireColumn.Delete Else For i = c_ To 1 Step -1 r_ = Cells(Rows.Count, i).End(3).Row If r_ <= r0_ Then Columns(i).Delete Next i End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
[/vba]
А у меня без файла только так [vba]
Код
Sub tt() c_ = Cells(1).SpecialCells(xlLastCell).Column r_ = Cells(1).SpecialCells(xlLastCell).Row r0_ = 5 Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual If r_ <= r0_ Then Cells(1).Resize(1, c_).EntireColumn.Delete Else For i = c_ To 1 Step -1 r_ = Cells(Rows.Count, i).End(3).Row If r_ <= r0_ Then Columns(i).Delete Next i End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
Sub DeleteColumns() With Application: .ScreenUpdating = False: .EnableEvents = False Dim LastCol&, i& LastCol = .ActiveSheet.UsedRange.SpecialCells(xlLastCell).Column For i = LastCol To 1 Step -1 If .WorksheetFunction.CountA(Range(Cells(6, i), Cells(Rows.Count, i))) = 0 Then Columns(i).Delete Next .ScreenUpdating = True: .EnableEvents = True: End With End Sub
[/vba]
GhOsT, или вот так [vba]
Код
Sub DeleteColumns() With Application: .ScreenUpdating = False: .EnableEvents = False Dim LastCol&, i& LastCol = .ActiveSheet.UsedRange.SpecialCells(xlLastCell).Column For i = LastCol To 1 Step -1 If .WorksheetFunction.CountA(Range(Cells(6, i), Cells(Rows.Count, i))) = 0 Then Columns(i).Delete Next .ScreenUpdating = True: .EnableEvents = True: End With End Sub
Товарищи, подскажите код, пожалуйста если требуется оставить столбцы по условию, а остальные удалить? Мне , к примеру, нужно оставить стоблец2,4, 8 и 10
Товарищи, подскажите код, пожалуйста если требуется оставить столбцы по условию, а остальные удалить? Мне , к примеру, нужно оставить стоблец2,4, 8 и 10monstr_ork