从具有数据的单元格中迭代并复制数据,以获取该单元格之前没有数据的单元格

时间:2015-11-03 21:41:50

标签: excel vba excel-formula

下面我列出了我需要帮助的表格。我试图做的是遍历列表并将日期(计划的或实际的)复制到单元格之前,如果它们是空的,并且如果之后没有数据单元格用于特定类型,则输入默认日期之后的一年。

**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

1 个答案:

答案 0 :(得分:0)

好的,我写过一些应该让你入门的东西。

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