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

因此，例如，如果两行的ID列中都有数字123，并且第一行的Name列列出了Timothy，第二行列出了Tim，则脚本应该将行更改为说Bob并说最远列更改了什么。或者，如果第一行或第二行有一个空单元格，而另一行没有，则来自非空单元格的数据将被合并/复制到空单元格中。

只要可以填充所有空白单元格，覆盖哪个数据都没关系。

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循环在迭代时会执行此操作，因此您也不需要手动将For最终重置为3。

在评论后用========在代码中标记我的评论/更改。

使用VBA合并数据

1 个答案: