Использование VBA для объединения данных

Question

Идет прямо в MsgBox без каких-либо изменений.

Я уже некоторое время играю с этим кодом, так как я новичок в VBA. Мне известно, что этот скрипт не указывает на конкретную таблицу.

Private Sub MergeData()

'The cell it will use to search
Dim idCheck As Range
'The cell it will use to compare text
Dim currentCell As Range
'The cell is will use to compare duplicates
Dim oneRowBelow As Range
'Will briefly say if something changed in furthest column
Dim changes As String
'This will be used to format the "Changes" column
Dim rowNumberValue As Integer, columnNumberValue As Integer, rowBelow As Integer

colNum = 3
rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column
rowBelow = ActiveCell.Row + 1

'Searches by ID column
For Each idCheck In Worksheets("Test").Range("B2:B1000")
   'This checks to find duplicate ID rows
   If idCheck.Value = idCheck.Offset(-1, 0).Value Then
         'Goes from each column starting from the ID column (H = 7th letter in alphabet and H is the last column)
         'Technically S is the last column since S just lists what has changed
         For colNum = 3 To 7

            'Checks to see if the current cell has no value but the duplicate cell does
            If Cells(rowNumberValue, colNum) = "" And Cells(rowBelow, colNum) <> "" Then
               'Changes current cell value to the duplicate cell value
               Cells(rowNumberValue, colNum) = Cells(rowBelow, colNum)

               'Writes in the 19th column whether or not data has been changed
               changes = "Added"
               Cells(rowNumberValue, 19) = changes
               Cells(rowNumberValue, 19).Interior.ColorIndex = 4
            End If

            'Checks to see if current cell has value but the duplicate cell doesn't
            If Cells(rowNumberValue, colNum) <> "" And Cells(rowBelow, colNum) = "" Then
               'Merges the two cells ( Unfortunately .Merge takes the top cell value only)
               Range(Cells(rowNumberValue, colNum), Cells(rowBelow, colNum)).Merge

               'Writes in the 19th column whether or not data has been changed
               changes = "Added"
               Cells(rowNumberValue, 19) = changes
               Cells(rowNumberValue, 19).Interior.ColorIndex = 4
            End If

            'Checks to see if the cell value is different from the duplicate value
            If Cells(rowNumberValue, colNum) <> Cells(rowBelow, colNum) Then
               'This just sets the first value to the duplicate value (since it doesn't matter which one is overwritten)
               Cells(rowBelow, colNum) = Cells(rowNumberValue, colNum)

               'Writes in the 19th column whether or not data has been changed
               changes = "Changed"
               Cells(rowNumberValue, 19) = changes
               Cells(rowNumberValue, 19).Interior.ColorIndex = 6

            End If
         Next colNum
    End If
    colNum = 3
Next
    MsgBox "All done"
End Sub

Так, например, если две строки имеют номер 123 в столбце идентификатора, а в столбце Имя в первой строке указан Тимоти, а во второй строке указан Тим, сценарий должен изменить строку, чтобы сказать Боб и сказать дальше колонка что была изменена. Или, если в первой или второй строке есть пустая ячейка, а в другой нет, данные из непустой ячейки будут объединены / скопированы в пустую.

Неважно, какие данные будут перезаписаны, если заполнены все пустые ячейки, которые могут быть заполнены.

Answer 1

Из моего комментария я считаю, что вы вызываете ложные условия из-за того, где определены ваши переменные:

'Searches by ID column
For Each idCheck In Worksheets("Test").Range("B2:B1000")
    'find current cell's row to be used in if-statements
    rowNumberValue = ActiveCell.Row  'MOVED INTO ROW LOOP ==============
    rowBelow = ActiveCell.Row + 1  'MOVED INTO ROW LOOP ==============
   'This checks to find duplicate ID rows
   If idCheck.Value = idCheck.Offset(-1, 0).Value Then
         'Goes from each column starting from the ID column (H = 7th letter in alphabet and H is the last column)
         'Technically S is the last column since S just lists what has changed
         For colNum = 3 To 7 'COLNUM IS DEFINED, NOT NEEDED BEFOREHAND ==========
             columnNumberValue = ActiveCell.Column 'if you need this, put it inside of this section, but you shouldn't need it due to colNum existing =========
             'Your other code here
         Next colNum
    End If
Next

Вам также не нужно вручную сбрасывать colNum на 3 в конце, потому что цикл For делает это во время итерации.

Помечены мои комментарии / изменения в вашем коде с ======== после комментариев.