Parar a macro do VBA ao atingir uma linha vazia

Question

Eu tentei recentemente usar Macros para simplificar algumas tarefas no Excel 2010, já que estou trabalhando com grandes bancos de dados infelizes.

Eu já encontrei o código que eu precisava para mesclar linhas duplicadas e concatenando dados / comentários únicos graças a este segmento que salva vidas: Como combinar valores de várias linhas em uma única linha no Excel?

O código era fácil de entender para um iniciante como eu (eu quero e tento entender o que estou fazendo, em vez de apenas copiar e colar cegamente). O único problema que encontrei é que a macro não parece parar na última linha e acaba preenchendo o resto da planilha do Excel.

O resultado desejado foi obtido como visto na linha 4 a 6, mas a partir da linha 29 ... Noentanto,vocêpodeverque,apartirdalinha29,amacrocontinuaaexibir";" na 10ª coluna.

Aqui está o código que eu adaptei:

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

Não sei ao certo por que ele não está sendo interrompido e não quero inserir uma linha final específica, já que o banco de dados com o qual estou trabalhando varia a cada semana.

Eu tentei redefinir a última linha como:

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

Mas notei quaisquer alterações.

Eu ficaria grato por qualquer ajuda!

Muito obrigado antecipadamente, KuroNavi

    

Answer 1

Sua última linha não é a última linha da tabela, mas há 3 linhas vazias incluídas na parte inferior, que são preenchidas por; porque sua macro contém esta linha:

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

Este comando basicamente diz: junte a linha vazia com a linha vazia e separe com

Mas você não quer verificar se há linhas vazias. Então o seu sub deve ser o seguinte:

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

Eu também alterei a declaração de suas variáveis de longs para inteiros, porque você está trabalhando com números inteiros que não excedam os limites de um inteiro, portanto, consome menos memória.