如何找到包含数据vba的单元格的最后一行来设置打印区域?

时间:2017-08-16 20:03:46

标签: excel vba excel-vba

我知道这个问题可能与过去的问题几乎相同,但我的表格中有一个细微差别,因为除了前7行之外,我的一列完全没空。问题是我的代码找到 ALL 单元格包含数据的最后一行,而不是包含至少一个数据项的最后一行。即A1:Q7包含数据,因为所有行都包含数据,所以我的代码将打印区域设置为A1:Q7,尽管C14中有数据。我希望我的打印区域为A1:Q14。我该怎么做呢代码如下。

Sub SetPrintArea()

Dim ALastFundRow As Integer
Dim AFirstBlankRow As Integer
Dim wksSource As Worksheet
Dim ws As Worksheet

Dim rngSheet As Range

Set wksSource = ActiveWorkbook.Sheets("WIRE SCHEDULE")
Set ws = ThisWorkbook.Sheets("WIRE SCHEDULE")

'Finds last row of content
ALastFundRow = wksSource.Range("A8").End(xlDown).Row
 'Finds first row without content
AFirstBlankRow = ALastFundRow + 1

Set rngSheet = ws.Range("A1:Q" & LastFundRow + 7)

'Sets PrintArea to the last Column with a value and the last row with a value
ws.PageSetup.PrintArea = rngSheet.Address

End Sub

一切都会有所帮助。谢谢!

3 个答案:

答案 0 :(得分:0)

函数 GetLastCell()会找到包含数据的最后一行和列

Option Explicit

Public Sub SetPrintArea()

    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("WIRE SCHEDULE")

    ws.PageSetup.PrintArea = ws.Range("A1:" & GetLastCell(ws).Address).Address

End Sub
Public Function GetLastCell(Optional ByVal ws As Worksheet = Nothing) As Range
    Dim uRng As Range, uArr As Variant, r As Long, c As Long
    Dim ubR As Long, ubC As Long, lRow As Long

    If ws Is Nothing Then Set ws = Application.ThisWorkbook.ActiveSheet
    Set uRng = ws.UsedRange:    uArr = uRng
    If IsEmpty(uArr) Then
        Set GetLastCell = ws.Cells(1, 1):   Exit Function
    End If
    If Not IsArray(uArr) Then
        Set GetLastCell = ws.Cells(uRng.Row, uRng.Column):  Exit Function
    End If
    ubR = UBound(uArr, 1):      ubC = UBound(uArr, 2)
    For r = ubR To 1 Step -1    '----------------------------------------------- last row
        For c = ubC To 1 Step -1
            If Not IsError(uArr(r, c)) Then
                If Len(Trim$(uArr(r, c))) > 0 Then
                    lRow = r:   Exit For
                End If
            End If
        Next
        If lRow > 0 Then Exit For
    Next
    If lRow = 0 Then lRow = ubR
    For c = ubC To 1 Step -1    '----------------------------------------------- last col
        For r = lRow To 1 Step -1
            If Not IsError(uArr(r, c)) Then
                If Len(Trim$(uArr(r, c))) > 0 Then
                    Set GetLastCell = ws.Cells(lRow + uRng.Row - 1, c + uRng.Column - 1)
                    Exit Function
                End If
            End If
        Next
    Next
End Function

UR

答案 1 :(得分:0)

 With ActiveSheet 'or whatever worksheet  
 LastRow = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByRows, _
                    searchdirection:=xlPrevious).Row
End With

您可以为最后一列使用类似的算法。

LastCol = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                LookIn:=xlValues, searchorder:=xlByColumns, _
                searchdirection:=xlPrevious).Column

请注意,我们正在寻找xlValues,因此不会包含带有返回空字符串的公式的单元格。

如果工作表为空,则代码将产生错误;所以如果可能的话,你应该测试一下。

答案 2 :(得分:0)

试试这段代码。

.Cells.Find(" *",SearchOrder:= xlByRows,SearchDirection:= xlPrevious).Row

Sub SetPrintArea()

Dim ALastFundRow As Integer
Dim AFirstBlankRow As Integer
Dim wksSource As Worksheet
Dim ws As Worksheet

Dim rngSheet As Range

Set wksSource = ActiveWorkbook.Sheets("WIRE SCHEDULE")
Set ws = ThisWorkbook.Sheets("WIRE SCHEDULE")

'Finds last row of content
'ALastFundRow = wksSource.Range("A8").End(xlDown).Row
ALastFundRow = wksSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 'Finds first row without content
AFirstBlankRow = ALastFundRow + 1

Set rngSheet = ws.Range("A1:Q" & LastFundRow)

'Sets PrintArea to the last Column with a value and the last row with a value
ws.PageSetup.PrintArea = rngSheet.Address
End Sub