VBA Lastrow不包括某些价值观

时间:2016-10-31 08:33:12

标签: excel vba

我制作了这个宏(并且它有效!)但是我想扩展它。 "数据"中的一些数据。表格无关紧要,我不想在" Databehandling"中自动填充这些行。片材。

我想更改LastRow定义。我的数据表中的G列包含很多日期和时间(例如2016-09-26 09:42:56.290)以及与上次日期(2016-09-26)相关的数据与我的分析混淆了很多为null值,因为还没有数据。由于我必须定期更新此工作簿,因此我不能说排除2016-09-26。宏必须查看数据表最底部的日期并移动选择,以便这些日期不包含在选择中。

那我怎么能这样做呢?

Sub Kviklevering_Drag_Down()

On Error GoTo errHandler
Application.ScreenUpdating = False

    With ActiveWorkbook
    Lastrow = ActiveWorkbook.Sheets("Data").UsedRange.Rows.Count

    Sheets("Databehandling").Activate

    Range("A2:V2").Select

    Selection.AutoFill Destination:=Range("A2:V" & Lastrow), Type:=xlFillDefault
    End With

Sheets("Databehandling").Visible = False
Sheets("Data").Activate

Application.ScreenUpdating = True

errHandler:
Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:0)

我已经更新了你的代码。删除了查看ActiveBook,激活工作表并将错误处理程序移到主程序之外(在Exit Sub之后,但在End Sub之前)。

Sub Kviklevering_Drag_Down()

    Dim CountOfMaxDate As Long
    Dim rLastCell As Range
    Dim rCountRange As Range
    Dim dMaxDate As Double


    'Are you sure it's always the ActiveWorkbook?
    'May be better to use ThisWorkbook which is always the file with this code in,
    'or a specific named workbook.
    'With ActiveWorkbook
   On Error GoTo ErrorHandler

    With ThisWorkbook

        With Worksheets("Data")
            'Find last cell in column G (column 7).
            Set rLastCell = .Cells(.Rows.Count, 7).End(xlUp)
            If rLastCell.Row = 1 Then
                Err.Raise vbObjectError + 1000, , "Last Cell is row 1"
            End If
            Set rCountRange = .Range(.Cells(1, 7), rLastCell)
            'Get the value of the last date.
            dMaxDate = Int(rLastCell)

            'Count the last date.
            CountOfMaxDate = WorksheetFunction.CountIfs(rCountRange, ">=" & dMaxDate, rCountRange, "<" & dMaxDate + 1)
        End With

        'No need to active this sheet - can leave it hidden if you want.
        With Worksheets("Databehandling")
            .Range("A2:V2").AutoFill Destination:=.Range("A2:V" & rLastCell.Row - CountOfMaxDate), Type:=xlFillDefault
        End With

    End With

FastExit:
    'Tidy up before exiting procedure.

Exit Sub

   On Error GoTo 0
   Exit Sub

ErrorHandler:

    Select Case Err.Number
        Case -2147220504 'Last Cell is row 1
            'Handle error.

            'Possible things to do after error handled:
            'Resume Next
            'Resume
            'Resume FastExit
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Kviklevering_Drag_Down."
    End Select

End Sub