0
我試圖做一個宏，將從其他報告複製範圍，並將它們放入一個大報告。範圍複製工作正常，並確實是它應該的。我現在遇到的問題是如何使用vba獲取日曆週日期（日曆周的週一）。我知道要做到這一點的Excel公式，但我似乎無法弄清楚如何在vba中實現。 （日曆中包含年份的單元格，1,3）+具有日曆星期編號（即日曆星期13）的單元格* 7如何自動填充公式VBA
= DATE（包含年份的單元格，1，-2）-WEEKDAY處理獲取每個日曆周的星期一的最佳方式是什麼？
我試過的當前自動填充方法給了我一個運行時錯誤'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' –
只是一個快速的修正，如果它存在於你的代碼，以及 - 就行'範圍（「P1」）的自動填入目的地：=範圍（firstCellD，lastCellD），類型：= xlFillDefailt'，它應該是「xlFillDefault」。它不應該在這種情況下有所作爲，因爲xlFillDefault爲0，但仍值得修復。將'Option Explicit'添加到代碼模塊的頂部，讓VBA爲您標識未聲明的變量。 – Blackhawk
@Siddharth潰敗我想實現你的建議，但它實際上並沒有改變什麼。 – user2843579