復制單元格直到下一個日期並重復

Question

我在一欄中有日期。 每個日期由8個單元格分隔，這8個單元格為空。 我想用第一個日期填充8個空單元格到達下一個日期時，我想用下一個日期填充接下來的8個空單元格，然后重復直到直到最后一個日期為止，之后再填充以下8個空單元格最后日期。

我認為我的問題還不夠清楚，因為我沒有正確的答案

應該變成

這是我從whytheq quickandfun方法獲得的輸出

我也嘗試將公式更改為

.Value = "=R[-1]C1"

解決了下面的答案

lastRow1 = Sheets(myValue).Cells(Sheets(myValue).Rows.Count, "B").End(xlUp).Row + 7

For r = 2 To lastRow1
If Sheets(myValue).Cells(r, 2) = vbNullString Then
Sheets(myValue).Cells(r, 2) = Sheets(myValue).Cells(r, 2).Offset(-1, 0)

End If
Next

Answer 1

像這樣的事情應該做的工作：

Dim wsh As Worksheet
Dim i As Integer, sCol As String
Dim cd Date, dd As Date

'column name which stores dates
sCol = "A"
cd = Date 'get current date
'Replace "Sheet1" with proper sheet name
Set wsh = ThisWorkbook.Worksheets("Sheet1")
'starting row
i = 1 'if the first date is in 1. row
'get first date
dd = CDate(wsh.Range(sCol & i))
'till the date from cell is less then current date 
Do While dd<cd
    'till the next cell is empty
    Do While wsh.Range(sCol & i+1)=""
        wsh.Range(sCol & i) = dd
        i = i + 1
    Loop
    'get next date
    dd = CDate(wsh.Range(sCol & i))
Loop

'here add another loop, you have to define condition to recognize last empty cell - as whytheq mentioned in the comment to the my answer

Set wsh = Nothing

注意： 此代碼不限於連續8個空單元格！

Answer 2

不是很漂亮：

Sub eightAtATime()

dim colLetter as string
colLetter = "A"

Dim r As Integer
With ThisWorkbook.ActiveSheet
   r = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

Do Until r < 1
    Range(colLetter  & r + 1 & ":" & colLetter  & r + 8) = Range(colLetter & r)
    r = r - 9
Loop

End Sub

盡管類似下面的內容更有趣，並且無論是否填充8個單元格都將填補空白：盡管它假定在最后一個單元格之后填充8個單元格：

Sub quickAndFun()

Dim lastRow As Integer
With ThisWorkbook.ActiveSheet
   lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

With Range("A1:A" & lastRow + 8).SpecialCells(xlCellTypeBlanks)
    .Value = "=R[-1]C1"
End With

End Sub

如果第一個單元格是B3嘗試以下操作：

Sub quickAndFun()

Dim lastRow As Integer
With ThisWorkbook.ActiveSheet
   lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
End With

With Range("B3:B" & lastRow + 8).SpecialCells(xlCellTypeBlanks)
    .Value = "=R[-1]C2" '<<<<now ok as it need to reference Column 2
End With

End Sub

復制單元格直到下一個日期並重復

問題描述

2 個解決方案

解決方案1
1 2015-08-17 22:00:42

解決方案2
1 已采納 2015-08-17 22:09:32

復制單元格直到下一個日期並重復

問題描述

2 個解決方案

解決方案1 1 2015-08-17 22:00:42

解決方案2 1 已采納 2015-08-17 22:09:32

解決方案1
1 2015-08-17 22:00:42

解決方案2
1 已采納 2015-08-17 22:09:32