如何清除 16000 行文件的 vba 上的错误 1004？

Question

我目前正在处理 16 000 行 excel 文件

B 列是我要更新的日期
H 列是开始日期
第一列是结束日期
K列为日期需要更新的次数（更新n行）

想法是在 B 列中显示从开始日期到结束日期的所有日期（每列一个日期）。

您会在下面找到我当前的代码。我是初学者，估计错误比较多。

Sub Dates()
    Dim i As Long
    Dim k As Long
    Dim MyDate As Long
    Dim EndDate As Long
    Dim EndRowA As Long
    Dim EndRowB As Long
    Dim EndRowH As Long
    Dim StartDate As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")

    StartDate = ws.Cells(ws.Rows.Count, "H").Value
    MyDate = ws.Cells(ws.Rows.Count, "B").Value
    EndDate = ws.Cells(ws.Rows.Count, "I").Value
    EndRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    EndRowB = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    EndRowH = ws.Cells(ws.Rows.Count, 8).End(xlUp).Row

    Do While (i <= EndRowH And i <= EndRowA And i <= EndRowB)
        If ws.Cells(i, "H").Value = ws.Cells(i, "I").Value Then
            GoTo Continue
        ElseIf ws.Cells(i, "H").Value = ws.Cells(i, "I").Value Then
            For k = 1 To ws.Cells(i, k).Value
                ws.Cells(i + 1, "B").Select
                ws.Cells(i, "B").Value = ws.Cells(i - 1, "H").Value + 1
                Exit For
Continue:
            Next k
        End If
    Loop
End Sub

你能给我一些帮助吗，我一直在网上收到错误 1004:

If ws.Cells(i,"H").Value = ws.Cells(i, "I").Value Then

电子表格中的主要列应如下所示：

Type    Date     Start date   End Date   #

A   01/01/2018  01/01/2018  01/10/2018  10
A   01/02/2018  01/01/2018  01/10/2018  10
A   01/03/2018  01/01/2018  01/10/2018  10
A   01/04/2018  01/01/2018  01/10/2018  10
A   01/05/2018  01/01/2018  01/10/2018  10
A   01/06/2018  01/01/2018  01/10/2018  10
A   01/07/2018  01/01/2018  01/10/2018  10
A   01/08/2018  01/01/2018  01/10/2018  10
A   01/09/2018  01/01/2018  01/10/2018  10  
A   01/10/2018  01/01/2018  01/10/2018  10
B   02/06/2018  02/06/2018  02/10/2018  5
B   02/07/2018  02/06/2018  02/10/2018  5
B   02/08/2018  02/06/2018  02/10/2018  5
B   02/09/2018  02/06/2018  02/10/2018  5
B   02/10/2018  02/06/2018  02/10/2018  5

先谢谢你了

Answer 1

你的循环中有几个问题：

i 一直是 0。您没有为 i 设置起始值，也没有增加 i，所以它整天保持 0。并且行计数从 1 开始，没有行 0。这就是你得到错误的原因。因此，为 i 设置一个有效的起始行，并在循环中执行 i = i + 1 以增加它，否则你将陷入无限循环。
您的 GoTo Continue 直接跳入 For k 循环。那行不通的。可能你的意思是目的地 Continue: 在 Next k
ws.Cells(i + 1, "B").Select没用。完全避免使用 select。

Do While (i <= EndRowH And i <= EndRowA And i <= EndRowB)
    If ws.Cells(i, "H").Value = ws.Cells(i, "I").Value Then
        GoTo Continue
    ElseIf ws.Cells(i, "H").Value = ws.Cells(i, "I").Value Then
        For k = 1 To ws.Cells(i, "K").Value
            'ws.Cells(i + 1, "B").Select 'does nothing useful here
            ws.Cells(i, "B").Value = ws.Cells(i - 1, "H").Value + 1
            Exit For
        Next k
    End If
Continue: 'moved 
    i = i + 1 'increment i
Loop

Answer 2

首先，需要将i初始化为数值，否则第0行会报错

其次，你的循环可以改进：

Do While (i <= EndRowH And i <= EndRowA And i <= EndRowB)

你可以寻找这3个EndRow的Min值，就像下面的部分，然后切换到For循环：

EndRow = WorksheetFunction.Min(EndRowA, EndRowB, EndRowH)       
For i = 1 To EndRow ' <-- starting loop from the 1st row

第三个：你有If .Cells(i, "H").Value = .Cells(i, "I").Value Then，在你的ElseIf中你有ElseIf .Cells(i, "H").Value = .Cells(i, "I").Value Then，这是完全相同的标准>>最有可能你的意思是用别的东西。

第四：我认为你放错了Continue:标签的位置。

有关您的代码错误的更多解释，请参阅下面的代码。

修改代码

Option Explicit

Sub Dates()

Dim i As Long
Dim k As Long
Dim MyDate As Long
Dim EndDate As Long
Dim EndRowA As Long
Dim EndRowB As Long
Dim EndRowH As Long
Dim EndRow As Long
Dim StartDate As Long
Dim ws As Worksheet

Set ws = Worksheets("Sheet1")

With ws
    StartDate = .Cells(.Rows.Count, "H").Value
    MyDate = .Cells(.Rows.Count, "B").Value
    EndDate = .Cells(.Rows.Count, "I").Value
    EndRowA = .Cells(.Rows.Count, 1).End(xlUp).Row
    EndRowB = .Cells(.Rows.Count, 2).End(xlUp).Row
    EndRowH = .Cells(.Rows.Count, 8).End(xlUp).Row

    ' get the minimumm last row from: EndRowA, EndRowB, EndRowH
    EndRow = WorksheetFunction.Min(EndRowA, EndRowB, EndRowH)

    For i = 1 To EndRow ' <-- starting loop from the 1st row
        If .Cells(i, "H").Value = .Cells(i, "I").Value Then
            GoTo Continue
        ElseIf .Cells(i, "H").Value = .Cells(i, "I").Value Then ' <-- same exact criteria as in your If
            For k = 1 To ws.Cells(i, k).Value
                ws.Cells(i + 1, "B").Select ' <-- not sure what do you need this line ???
                .Cells(i, "B").Value = .Cells(i - 1, "H").Value + 1
                Exit For
Continue: '<-- not sure if this is placed correctly ??
            Next k
        End If
    Next i

End With

End Sub

Answer 3

最终，我认为这就是您要找的东西：

Sub tgr()

    Dim ws As Worksheet

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    With ws.Range("B2", ws.Cells(ws.Rows.Count, "B").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data
        .Formula = "=IF(H" & .Row - 1 & "<>H" & .Row & ",H" & .Row & ",B" & .Row - 1 & "+1)"
        .Value = .Value
        .NumberFormat = "dd/mm/yyyy"
    End With

End Sub

如何清除 16000 行文件的 vba 上的错误 1004？

How to clear error 1004 on vba on a 16000 lines file?

vba

excel

excel-2010

excel-2007