在單元格之前用單元格的數據迭代和複製單元格中的數據

Question

下面列出了我需要幫助的表格。我想要做的是遍歷列表，並將日期（計劃的或實際的）複製到單元格之前，如果它們是空的，並且之後沒有數據單元格，則輸入特定類型的默認日期一年後。

**Category** **Type** **Planned Date** **Actual End Date** 
Fruit   Banana  
Fruit   Banana  
Fruit   Banana  
Fruit   Banana        18/06/2015 
Fruit   Banana  
Fruit   Banana  
Fruit   Banana   11/11/2017 
Fruit   Banana  
Fruit   Banana   21/12/2017 
Fruit   Apple  
Fruit   Apple  
Fruit   Apple  
Fruit   Apple        11/01/2015 
Fruit   Apple  
Fruit   Apple  
Fruit   Apple  
Fruit   Apple  
Fruit   Apple   18/12/2015  

Veg   Cucumber  
Veg   Cucumber  

Veg   Cucumber  12/01/2016 

Veg   Cucumber  

Veg   Cucumber  25/06/2016  

Veg   Cucumber  
Veg   Cucumber  
Veg   Cucumber  03/11/2016  
Veg   Cucumber  

我希望它看起來像這樣;

**Category** **Type** **Planned Date** **Actual End Date** 
Fruit   Banana        18/06/2015 
Fruit   Banana        18/06/2015 
Fruit   Banana        18/06/2015 
Fruit   Banana        18/06/2015 
Fruit   Banana   11/11/2017 
Fruit   Banana   11/11/2017 
Fruit   Banana   11/11/2017 
Fruit   Banana   21/12/2017 
Fruit   Banana   21/12/2017 
Fruit   Apple        11/01/2015 
Fruit   Apple        11/01/2015 
Fruit   Apple        11/01/2015 
Fruit   Apple        11/01/2015 
Fruit   Apple   18/12/2015 
Fruit   Apple   18/12/2015 
Fruit   Apple   18/12/2015 
Fruit   Apple   18/12/2015 
Fruit   Apple   18/12/2015  

Veg   Cucumber  12/01/2016 
Veg   Cucumber  12/01/2016 

Veg   Cucumber  12/01/2016 

Veg   Cucumber  25/06/2016 

Veg   Cucumber  25/06/2016  

Veg   Cucumber  03/11/2016 
Veg   Cucumber  03/11/2016 
Veg   Cucumber  03/11/2016  
Veg   Cucumber  01/01/2018 

Answer 1

好的，我寫了一些應該讓你開始的東西。

Sub test() 
Dim wsLastRow&, partLastRow&, nextRow&, firstRow& 
Dim i&, k& 
Dim custDate$ 

wsLastRow = Cells(Rows.Count, 1).End(xlUp).Row ' this assumes your Column A will have the most data 

For k = 3 To 4 ' using columns C and then D 
    For i = wsLastRow To 2 Step -1 
     If IsEmpty(Cells(i, k)) Then 
      custDate = WorksheetFunction.Text(InputBox("What date do you want to put, as there isn't one currently (dd/mm/yyyy)"), "dd/mm/yyyy") 
      Cells(i, k).Value = custDate 
     Else 
      firstRow = i 
      partLastRow = Cells(i, k).End(xlUp).Row + 1 
      Range(Cells(firstRow, k), Cells(partLastRow, k)).FillUp 
      i = partLastRow 
     End If 
    Next i 
Next k 
End Sub 

注：當有一個空白單元格，沒有一個日期，它會每次提示的日期。讓我知道你想如何處理這樣的日期，並且我們可以更新它來做其他事情。如果你通過代碼F8，你會看到這是如何工作的。讓我知道任何必要的想法/更改！

編輯：

下面的代碼應該工作，按你的意見和決賽桌的例子。

Sub test2() 
Dim wsLastRow&, partLastRow&, nextRow&, firstRow& 
Dim i&, k& 
Dim custDate$ 
Dim runLastRow As Boolean 

runLastRow = False 

wsLastRow = Cells(Rows.Count, 1).End(xlUp).Row ' this assumes your Column A will have the most data 
custDate = WorksheetFunction.Text(InputBox("What date do you want to put, when there isn't one? (dd/mm/yyyy)"), "dd/mm/yyyy") 

k = 3      'noting the "C" Column 

For i = wsLastRow To 2 Step -1 
    If IsEmpty(Cells(i, 3)) And IsEmpty(Cells(i, 4)) Then 
     Cells(i, k).Value = custDate 
     runLastRow = False 
    ElseIf IsEmpty(Cells(i, k)) And Cells(i, k + 1) <> "" Then 
     k = 4    ' Set the column to use as K 
     runLastRow = True 
    Else 
     k = 3 
     runLastRow = True 
    End If 

    If runLastRow Then 
     firstRow = i 
     partLastRow = WorksheetFunction.Max(Cells(i, 3).End(xlUp).Row + 1, Cells(i, 4).End(xlUp).Row + 1) 
     Range(Cells(firstRow, k), Cells(partLastRow, k)).FillUp 
     i = partLastRow 
    End If 

Next i 

End Sub