到达空行时停止 VBA 宏

到达空行时停止 VBA 宏

由于我正在处理庞大的数据库,我最近尝试使用宏来简化 Excel 2010 下的某些任务。

感谢这个救命的线程,我已经找到了合并重复行和连接唯一数据/注释所需的代码:如何在 Excel 中将多行的值合并为一行?

对于像我这样的初学者来说,代码很容易理解(我确实想并尝试理解我在做什么,而不是盲目地复制粘贴)。我遇到的唯一问题是宏似乎不会在最后一行停止,最终会填满 Excel 表的其余部分。

从第 4 行到第 6 行都获得了想要的结果,但是从第 29 行开始……图像 然而您可以看到,从第 29 行开始,宏一直在第 10 列添加“;”。

以下是我修改的代码:

Sub merge_dupes_and_comments()
'define variables

Dim RowNum As Long, LastRow As Long

Application.ScreenUpdating = False

RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
Range("A2", Cells(LastRow, 10)).Select

For Each row In Selection
    With Cells
    'if OC number matches
    If Cells(RowNum, 2) = Cells(RowNum + 1, 2) Then
        'and if position and material match
        If Cells(RowNum, 4) = Cells(RowNum + 1, 4) Then
        If Cells(RowNum, 5) = Cells(RowNum + 1, 5) Then
        'move updated comments up next to the old comment and delete empty line
            Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)
            Rows(RowNum + 1).EntireRow.Delete
       End If
        End If
         End If
         End With

RowNum = RowNum + 1
Next row

Application.ScreenUpdating = True

End Sub

我不太清楚为什么它没有停止,而且我不想输入特定的结束行,因为我使用的数据库每周都会变化。

我尝试将最后一行重新定义为:

Dim LastRow As Long

With ThisWorkbook.Worksheets("MasterData") 'enter name of the sheet you're working on
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).row
    Else
        LastRow = 1
    End If

但我注意到了任何变化。

如能得到任何帮助我将非常感激!

非常感谢,KuroNavi

答案1

您的最后一行不是表格的最后一行,但底部包含 3 个空行,用 ; 填充,因为您的宏包含此行:

        Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)

这个命令的基本意思是:用空行连接空行并用空行分隔;

但您不想检查空行。因此您的子程序应如下所示:

Sub merge_dupes_and_comments()
    'define variables
    Dim RowNum As Integer, LastRow As Integer, EmptyCells as Integer

    Application.ScreenUpdating = False

    RowNum = 2
    LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
    Range("A2", Cells(LastRow, 10)).Select

    For Each row In Selection
        'Do we have am empty row? If so exit the loop.
        'Lets count the amount of empty cells on the row.
        EmptyCells=0
        For c = 1 to 10   
            if Cells(RowNum,c) = "" then EmptyCells = EmptyCells+1
        Next c

        'If we find more than 9 empty cells, assume the row is empty, and exit the loop.
        if EmptyCells > 9 then exit for

        'Lets continue the duplicate checking
        'if OC number matches
        'and if position and material match
        If Cells(RowNum, 2) = Cells(RowNum + 1, 2) AND _
           Cells(RowNum, 4) = Cells(RowNum + 1, 4) AND _
           Cells(RowNum, 5) = Cells(RowNum + 1, 5) Then
           'move updated comments up next to the old comment and delete empty line
            Cells(RowNum, 10) = Cells(RowNum, 10) & ";" & Cells(RowNum + 1, 10)
            Rows(RowNum + 1).EntireRow.Delete
       End If

    RowNum = RowNum + 1
Next row

Application.ScreenUpdating = True

End Sub

我还将变量的声明从长整型更改为整数,因为您只处理不会超出整数边界的整数,因此消耗的内存更少。

相关内容