【发布时间】：2013-10-28 19:47:20
【问题描述】：
我正在尝试制作一个宏来复制其他报告中的范围并将它们放入一个大报告中。范围复制工作正常，并且完全符合预期。我现在遇到的问题是如何使用 vba 获取日历周日期（日历周的星期一）。我知道执行此操作的 excel 公式，但我似乎无法弄清楚如何在 vba 中实现。
=DATE(带有年份的单元格, 1, -2)-WEEKDAY(DATE(带有年份的单元格,1,3))+带有日历周数的单元格（即日历周13）*7
获取每个日历周的星期一日期的最佳方法是什么？
我尝试的当前自动填充方法给了我一个运行时错误'1004：Range 类的自动填充方法失败。
Sub BeginHere()
Dim wb As Workbook
Dim ws As Worksheet
Dim wbn As Workbook
Dim wsp As Worksheet
Dim year As String
Dim cw As String
Dim fileName As String
Dim formula As Range
Set wb = ThisWorkbook
Set ws = ActiveSheet
'Test Fulmula
Set formula = ws.Range("p1")
'Last Cell in Destination
Dim lastCellD As Range
'First cell in Destination
Dim firstCellD As Range
'Last Cell in Source
Dim lastCellS As Range
'First Cell in Source
Dim firstCellS As Range
Dim fileDir As String
Dim filePath As String
With Excel.Application
.ScreenUpdating = False
.Calculation = Excel.xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
End With
'get the last calendar week from the destination report
Set lastCellD = ws.Range("B7:B7").End(xlDown)
'calculate the next calendar week
cw = lastCellD.formula
cw = cw + 1
'Create file path using PQM directory with the cw and years
fileDir = "file directory here"
filePath = "file name here"
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range
Dim r6 As Range, r7 As Range, r8 As Range, r9 As Range, cwr As Range
Dim rm As Range, rdw As Range, ry As Range
'If the next report exist continue processing
If Dir(filePath) <> "" Then
'Open the source workbook
Set wbn = Workbooks.Open(filePath)
fileName = wbn.Name
year = Mid(fileName, 6, 4)
'Open the source worksheet
Set wsp = wbn.Worksheets("Problemliste")
'Get the cell after the last filled cell in the destination sheet for PQM numbers
Set lastCellD = ws.Cells(Rows.Count, "C").End(xlUp)
'Get the first and last cell in the source sheet to get the total number of used cells
Set firstCellS = wsp.Range("A7")
Set lastCellS = wsp.Cells(Rows.Count, "A").End(xlUp)
Set r1 = Range(firstCellS, lastCellS)
r1.Copy lastCellD.Offset(1, 0)
Set firstCellS = wsp.Range("B7")
Set lastCellS = wsp.Cells(Rows.Count, "B").End(xlUp)
Set r2 = Range(firstCellS, lastCellS)
r2.Copy lastCellD.Offset(1, 1)
Set firstCellS = wsp.Range("F7")
Set lastCellS = wsp.Cells(Rows.Count, "F").End(xlUp)
Set r3 = Range(firstCellS, lastCellS)
r3.Copy lastCellD.Offset(1, 2)
Set firstCellS = wsp.Range("H7")
Set lastCellS = wsp.Cells(Rows.Count, "H").End(xlUp)
Set r4 = Range(firstCellS, lastCellS)
r4.Copy lastCellD.Offset(1, 3)
Set firstCellS = wsp.Range("J7")
Set lastCellS = wsp.Cells(Rows.Count, "J").End(xlUp)
Set r5 = Range(firstCellS, lastCellS)
r5.Copy lastCellD.Offset(1, 4)
Set firstCellS = wsp.Range("Y7")
Set lastCellS = wsp.Cells(Rows.Count, "Y").End(xlUp)
Set r6 = Range(firstCellS, lastCellS)
r6.Copy lastCellD.Offset(1, 5)
Set firstCellS = wsp.Range("AK7")
Set lastCellS = wsp.Cells(Rows.Count, "AK").End(xlUp)
Set r7 = Range(firstCellS, lastCellS)
r7.Copy lastCellD.Offset(1, 6)
Set firstCellS = wsp.Range("BA7")
Set lastCellS = wsp.Cells(Rows.Count, "BA").End(xlUp)
Set r8 = Range(firstCellS, lastCellS)
r8.Copy lastCellD.Offset(1, 7)
Set firstCellS = wsp.Range("BE7")
Set lastCellS = wsp.Cells(Rows.Count, "BE").End(xlUp)
Set r9 = Range(firstCellS, lastCellS)
r9.Copy lastCellD.Offset(1, 8)
'Set firstCellD = last cell in column B
Set firstCellD = ws.Range("B7").End(xlDown)
'Offset to get the next empty row
Set firstCellD = firstCellD.Offset(1, 0)
'Set lastCellD = the bottom cell of column C
Set lastCellD = ws.Cells(Rows.Count, "C").End(xlUp)
'Offset by one column to get target column
Set lastCellD = lastCellD.Offset(0, -1)
'Create composit range in targer column
Set rcw = Range(firstCellD, lastCellD)
rcw.Value = cw
'put year in destination sheet
Set firstCellD = firstCellD.Offset(0, 11)
Set lastCellD = lastCellD.Offset(0, 11)
Set ry = Range(firstCellD, lastCellD)
ry.Value = year
'get calendar week date
Set firstCellD = firstCellD.Offset(0, -1)
Set lastCellD = lastCellD.Offset(0, -1)
Set rdw = Range(firstCellD, lastCellD)
'Here is where the error occures
'********************************************************************
Range("p1").Autofill Destination:=Range(firstCellD, lastCellD), Type:=xlFillDefailt
'********************************************************************
Set firstCellD = firstCellD.Offset(0, -1)
Set lastCellD = lastCellD.Offset(0, -1)
Set rm = Range(firstCellD, lastCellD)
'get month from the calendar week date
'rm.Formula = datepart(month)
wbn.Close
Else
MsgBox ("No new file")
End If
End Sub
【问题讨论】：
-
在黑暗中拍摄：
Range("P1:P" & lastCellD.Row).Formula = Range("P1").Formula -
只是一个快速更正，以防它也存在于您的代码中——在
Range("p1").Autofill Destination:=Range(firstCellD, lastCellD), Type:=xlFillDefailt行上，它应该是“xlFillDefault”。由于 xlFillDefault 为 0，因此在这种情况下应该没有什么不同，但仍然值得修复。将Option Explicit添加到代码模块的顶部，让 VBA 为您识别未声明的变量。 -
@Siddharth Rout 我尝试实施您的建议，但实际上并没有改变任何东西。
-
@Steve P 感谢您指出这一点
-
你能调试一下，告诉我
lastCellD.Row和Range("P1").Formula的值是什么