Как удалить все, что находится за пределами области печати в Excel? - PullRequest
0 голосов
/ 23 сентября 2019

Я новичок в VBA и пытаюсь удалить все, что находится за пределами указанной области печати, для каждого листа в моем файле.У меня есть код, который работает нормально, но для некоторых вкладок область печати начинается в столбце B, и мне нужно удалить столбец A, потому что он не находится в области печати.Я не могу понять, как переписать свой код, чтобы обеспечить удаление столбца слева от указанной области печати. ​​

Dim FirstEmptyRow As Long
Dim FirstEmptyCol As Integer
Dim rng As Range
With ActiveSheet.PageSetup
        If .PrintArea = "" Then
            Set rng = ActiveSheet.UsedRange
        Else
            Set rng = ActiveSheet.Range(.PrintArea)
        End If
    End With

    FirstEmptyCol = rng.Cells(rng.Cells.Count).Column + 1
    FirstEmptyRow = rng.Rows.Count + rng.Cells(1).Row

    Range(Cells(1, FirstEmptyCol), Cells(1, 256)).EntireColumn.Delete
    Range(Cells(FirstEmptyRow, 1), Cells(Rows.Count, 1)).EntireRow.Delete

Ответы [ 3 ]

1 голос
/ 24 сентября 2019

Вы можете попробовать это.Найдите PrintArea, а затем, используя Intersect, вы можете перебрать ячейки и найти, какие ячейки отсутствуют в ячейках PrintArea, Union, а затем удалить их в конце.Делая это таким образом, вы можете удалить все, что не является частью PrintArea, все одновременно.Надеюсь, это поможет:

Sub testPrintArea()
    Dim printAreaRange As Range
        With ActiveSheet.PageSetup
        If .PrintArea = "" Then
            Set printAreaRange = ActiveSheet.UsedRange
        Else
            Set printAreaRange = ActiveSheet.Range(.PrintArea)
        End If
    End With

    ' Get non print area cells and union them
    Dim nonPrintAreaCells As Range
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange
        If Intersect(cell, printAreaRange) Is Nothing Then
            If nonPrintAreaCells Is Nothing Then
                Set nonPrintAreaCells = cell
            Else
                Set nonPrintAreaCells = Union(nonPrintAreaCells, cell)
            End If
        End If
    Next cell

    ' do whatever...
    nonPrintAreaCells.Value = ""
End Sub
1 голос
/ 24 сентября 2019

Вы можете использовать свойства Column и Row диапазона, чтобы определить, где он начинается, например:

Sub DeleteOutsidePrintArea(ws As Worksheet)
    Dim rng As Range

    With ws
        If .PageSetup.PrintArea = vbNullString Then
            Set rng = .UsedRange
        Else
            Set rng = .Range(.PageSetup.PrintArea)
        End If

        ' Delete columns to left, if any
        If rng.Column > 1 Then
            .Columns(1).Resize(, rng.Column - 1).Delete
        End If

        ' Delete rows above, if any
        If rng.Row > 1 Then
            .Rows(1).Resize(rng.Row - 1).Delete
        End If

        ' Delete columns to right, if any
        If rng.Columns.Count < (.UsedRange.Columns.Count + .UsedRange.Column - 1) Then
            .Columns(rng.Columns.Count + 1).Resize(, .UsedRange.Columns.Count + .UsedRange.Column - 1 - rng.Columns.Count).Delete
        End If

        ' Delete rows below, if any
        If rng.Rows.Count < (.UsedRange.Rows.Count + .UsedRange.Row - 1) Then
            .Rows(rng.Rows.Count + 1).Resize(.UsedRange.Rows.Count + .UsedRange.Row - 1 - rng.Rows.Count).Delete
        End If
    End With
End Sub

Называйте это так

Sub Demo()
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook '<~~~ Adjust to suit
    For Each ws In wb.Worksheets
        DeleteOutsidePrintArea ws
    Next
End Sub

1 голос
/ 24 сентября 2019

Попробуйте добавить этот дополнительный код:

 If rng.Column > 1 Then
    Range(Cells(1, 1), Cells(1, rng.Column - 1)).EntireColumn.Delete
 End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...