我制作了这个宏(并且它有效!)但是我想扩展它。 "数据"中的一些数据。表格无关紧要,我不想在" 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
答案 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