添加缺少的日期VBA

本文介绍了添加缺少的日期VBA的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我必须在行中插入缺失的日期，而不能删除重复的日期(对于计费程序).示例数据:

I have to insert missing dates to a row without deleting the duplicated dates (for a billing program). Example data:

我的代码无限循环并删除重复的日期.为什么会这样?

My code is infinitely looping and deleting the duplicate dates. Why does this happen?

Sub InsertMissingDates()

Dim i As Long
Dim RowCount As Long

i = 4

Do
    If Cells(i, 1) + 1 <> Cells(i + 1, 1) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If
    i = i + 1
Loop Until Cells(i + 1, 1) = "31.10.2016"

End Sub

推荐答案

下面是修改后的代码，以解决您的问题

Here is the code modified with comments to address your issues

Sub InsertMissingDates()

Dim i As Long
Dim RowCount As Long

i = 4

Do
    'Use less then instead of <> so it doesn't flag duplicate cells
    If Cells(i, 1) + 1 < Cells(i + 1, 1) Then
        Rows(i + 1).Insert
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If
    'Second check to add value if the next row is blank
    If (Cells(i + 1, 1) = "") Then
        Cells(i + 1, 1) = Cells(i, 1) + 1
    End If

    i = i + 1
'Changed the loop function from cells(i+1,1) to cells(i,1) since you already
'incremented i
'Also made the date check slightly more robust with dateserial
Loop Until Cells(i, 1).Value >= DateSerial(2016, 1, 30)

End Sub

这篇关于添加缺少的日期VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！