VBA中只有一行的自动填充函数

Question

我有一个宏，它根据C列的最后一行自动填充，以填充a列中的2020和B列中的GM BCR；类的自动填充范围失败"；数据只有一行时出错。我试图写一个If语句，但它说需要object。

'Drag down 2020 & GM BCR'
Range("B" & ActiveCell.Row).Select
ActiveCell.FormulaR1C1 = "GM BCR"
Dim lastRow As Long
lastRow = Range("C" & Rows.Count).End(xlUp).Row
ActiveCell.AutoFill Destination:=Range(ActiveCell, Cells(Cells(Rows.Count, "C").End(xlUp).Row, "B"))
Range("A" & ActiveCell.Row).Select
ActiveCell.FormulaR1C1 = "2020"
Dim lastRow1 As Long
lastRow1 = Range("C" & Rows.Count).End(xlUp).Row
ActiveCell.AutoFill Destination:=Range(ActiveCell, Cells(Cells(Rows.Count, "C").End(xlUp).Row, "A"))

我知道我的代码可能不是最佳的，但不幸的是，这是我在时间紧张的时候能做的最好的事情。有人知道如何修复它吗？这样，如果我只有一行数据，它仍然可以输入一行数据？

Answer 1

这样就可以了。避免使用".Select"可能是值得的，因为这可能会导致很多问题。

Sub FillAandB()
Dim ws As Worksheet
Dim rngA As Range, rngB As Range
Dim lastRowC As Long
'use error handling
On Error GoTo err_hand
Set ws = ActiveSheet
'get last row of column C (i.e. #3)
lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
'set range A and B for all cells in those columns up to the last row of C
Set rngA = ws.Range(ws.Cells(1, 1), ws.Cells(lastRowC, 1))
Set rngB = ws.Range(ws.Cells(1, 2), ws.Cells(lastRowC, 2))
'turn screenupdating / calculation off for speed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'fill in ranges
rngA.Formula = 2020
rngB.Formula = "GM BCR"
'turn screenupdating / calculation back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
err_hand:

'turn screenupdating / calculation back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

'display error message
MsgBox err.Number & " - " & err.Description, vbCritical, "Error"

Exit Sub
End Sub