场景：我有一个代码，可以从其他文件中读取数据并导入到不同的工作表中。其中一些文件具有每月格式的数据，而其他文件则采用日常格式
每日数据示例（yyyy-mm-dd）：
item1 item2 item3
2010/01/01 1 1 1
2010/01/02 1 1 1
2010/01/03 1 1 1
2010/01/04 1 1 1
2010/01/05 1 1 1
每月数据示例（yyyy-mm-dd），这里的日期通常是该月的最后一个工作日：
item1 item2 item3
2010/01/31 5 3 1
2010/02/28 4 10 5
2010/03/31 7 9 2
2010/04/30 8 4 8
2010/05/31 2 7 7
目标：我正在尝试将所有月度数据转换为每日数据，方法是将月末值保持为当月所有日期的相同值。例如：如果我的2010/02/28值为10，则该项目的2月份所有日期的值应等于10。
我已尝试的内容：我尝试执行向后循环并添加列，但这不起作用。现在我正在尝试创建两个数组（每天一个和每月一个），并比较：循环到每月行，然后是每日行，如果月和年是相同的，那么使每日行的值等于每月（例如：2月份的所有每日价值将等于1月份的月度值，2月份的最后一天除外，这是2月份的月度值。类似的东西：
如果我1月份的1月份值为5，则2月份为10，而3月份则为3，那么我的每日数据将是（假设我的数据从1月份开始）：
01/01至30/01 = 5，31/01至27/02 = 10,28 / 02至30/03 = 3，依此类推。
问题：由于我正在尝试这样做，我无法正确组织循环，因此xx循环（对于列）最终会从错误的行获取数据。知道如何解决这个问题，或者如何以更有效的方式制定这个程序？
代码：
Private Sub CommandButton2_Click()
Dim monthlydatesarray As Variant, monthlydataarray As Variant, dailydatesarray As Variant, dailydataarray As Variant
Dim xx As Long, monthlydaterow As Long, dailydaterow As Long, lastRowD As Long, lastRowM As Long
Dim wbpath As String
Dim wb As Workbook
Dim ws As Worksheet
wbpath = ThisWorkbook.Path
Set wb = ThisWorkbook
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
lastRowD = Sheets("Bid").Cells.SpecialCells(xlCellTypeLastCell).Row
lastRowM = Sheets("AMT").Cells.SpecialCells(xlCellTypeLastCell).Row
For Each ws In wb.Worksheets
If ws.Name = "A" Then
'sets proper columns for dates and data, both monthly and daily
dailydatesarray = wb.Sheets("B").Range("A2:A" & lastRowD)
dailydataarray = wb.Sheets("B").UsedRange
monthlydatesarray = wb.Sheets("A").Range("A2:A" & lastRowM)
monthlydataarray = wb.Sheets("A").UsedRange
'if date matches month and year, use the data values
For monthlydaterow = 1 To UBound(monthlydatesarray)
For dailydaterow = 1 To UBound(dailydatesarray)
If Month(monthlydatesarray(monthlydaterow, 1)) = Month(dailydatesarray(dailydaterow, 1)) And Year(monthlydatesarray(monthlydaterow, 1)) = Year(dailydatesarray(dailydaterow, 1)) Then
'loop the columns to paste the monthly data into daily array
For xx = 2 To UBound(dailydataarray, 2)
dailydataarray(dailydaterow + 1, xx) = monthlydataarray(monthlydaterow, xx)
Next xx
End If
Next dailydaterow
Next monthlydaterow
'do one more loop to repaste the last date of the month properly
For monthlydaterow = 1 To UBound(monthlydatesarray)
For dailydaterow = 1 To UBound(dailydatesarray)
If monthlydatesarray(monthlydaterow) = dailydatesarray(dailydaterow) Then
For xx = 2 To UBound(dailydataarray, 2)
dailydataarray(dailydaterow, xx) = monthlydataarray(monthlydaterow, xx)
Next xx
End If
Next dailydaterow
Next monthlydaterow
ws.UsedRange.Clear
wb.Sheets("B").Range("A1").Resize(UBound(dailydataarray, 1), UBound(dailydataarray, 2)) = dailydataarray
ws.UsedRange.Columns(1).NumberFormat = "yyyy/mm/dd"
End If
Next ws
'Optimize Macro Speed End
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Process Finished"
End Sub
答案 0 :(得分：1)
尝试以下操作并告诉我您是否需要进行调整。应该真正动态地确定最后一列。可能甚至可以使用UsedRange，但让我们看看这是否适用于初学者。假设数据从A1中的标题开始。我可能会考虑更多，但这是海滩时间！
注意：您希望最后将数组输出到其他位置，以免覆盖现有数据（我相信还有更多列）
如果你想在上个月填充并使用版本1.如果你想要排除上个月前期填充使用版本2.请务必使用两个版本的功能。另外，确保输出第一列的格式为日期。
版本1
Option Explicit
Public Sub RepeatData1()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim sourceData As Range
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet7") 'change
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row 'change to appropriate column to get last row
Set sourceData = ws.Range("A2:D" & lastRow) 'change to get include last column
Dim inputArray()
Dim totalOutRows As Long
Dim i As Long
inputArray = sourceData.Value2
For i = 1 To UBound(inputArray, 1)
totalOutRows = totalOutRows + GetDaysInMonth(Application.WorksheetFunction.EoMonth(inputArray(i, 1), 1))
Next i
Dim outputArray()
ReDim outputArray(1 To totalOutRows, 1 To UBound(inputArray, 2))
Dim outputRow As Long
outputRow = 1
Dim j As Long
For i = 1 To UBound(inputArray, 1)
For j = 1 To UBound(inputArray, 2)
outputArray(outputRow, j) = inputArray(i, j)
Next j
Dim k As Long
For k = 1 To GetDaysInMonth(Application.WorksheetFunction.EoMonth(inputArray(i, 1), 1))
For j = 1 To UBound(inputArray, 2)
If j = 1 And outputRow > 1 Then
outputArray(outputRow, j) = inputArray(i, j) + k - 1
Else
outputArray(outputRow, j) = inputArray(i, j)
End If
Next j
outputRow = outputRow + 1
Next k
Next i
ws.Range("L2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray
End Sub
Public Function GetDaysInMonth(ByVal datum As Double) As Long
GetDaysInMonth = Day(DateSerial(Year(datum), Month(datum) + 1, 1) - 1)
End Function
第2版：
Option Explicit
Public Sub RepeatData()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim sourceData As Range
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet7") 'change
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row 'change to appropriate column to get last row
Set sourceData = ws.Range("A2:D" & lastRow) 'change to get include last column
Dim inputArray()
Dim totalOutRows As Long
Dim i As Long
inputArray = sourceData.Value2
For i = 2 To UBound(inputArray, 1)
totalOutRows = totalOutRows + GetDaysInMonth(inputArray(i, 1))
Next i
totalOutRows = totalOutRows + 1
Dim outputArray()
ReDim outputArray(1 To totalOutRows, 1 To UBound(inputArray, 2))
Dim outputRow As Long
outputRow = 1
Dim j As Long
For i = 1 To UBound(inputArray, 1) - 1
For j = 1 To UBound(inputArray, 2)
outputArray(outputRow, j) = inputArray(i, j)
Next j
Dim k As Long
For k = 1 To GetDaysInMonth(inputArray(i + 1, 1))
For j = 1 To UBound(inputArray, 2)
If j = 1 And outputRow > 1 Then
outputArray(outputRow, j) = inputArray(i, j) + k - 1
Else
outputArray(outputRow, j) = inputArray(i, j)
End If
Next j
outputRow = outputRow + 1
Next k
Next i
For j = 1 To UBound(inputArray, 2)
outputArray(UBound(outputArray, 1), j) = inputArray(UBound(inputArray, 1), j)
Next j
ws.Range("L2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray
End Sub