使用 VBA 对具有重复值的电子表格进行排序

Question

我正在尝试创建一个宏来检查 A 列（客户端 ID 号）的值，识别重复值，然后，一旦找到重复值，执行嵌套 If/Then 检查，将值返回到根据它找到的某些单元格。如果重复值对应的行的F列（程序描述）包含子串“UPGRADE”，则应使原值对应的行J列的文本等于重复值中F列的文本。然后，应该删除重复的行，但我还没有做到这一点。

这是我目前所拥有的-

Dim lastrow As Long

lastrow = Cells(Rows.Count, "A").End(xlUp).Row 'find last row in column A

For x = 1 To lastrow
If Cells(x, 1).Value <> ActiveCell.Value Then 'Check if cell in column A contains the same value as the activated cell 

 For y = 1 To lastrow
        If Cells(y, 1).Value = Cells(x, 1).Value Then 'Compares cell against each value in column A. If there is a match, the do the following:

If Cells(y,6).Value <> "UPGRADE" Then 'Checks if duplicate value contains "UPGRADE"

Cells (x,10).Value= Cells(y,10).Value 'If this value is found, copy the value of the duplicate program name into a specified column for that program type in row x.

Else Cells(x,12).Value=Cells(y,12).Value 'If the value is not found, copy the program type into a separate column for that program type in row x.
    End If
    Next y
End If
Next x

我尝试运行此程序并收到“Next without For”错误，但我不确定如何解决它，或者如果我这样做了代码是否可以工作。任何帮助将不胜感激。

Answer 1

目前尚不清楚您想要做什么，但是以下内容对您有用吗？

Public Sub checkDup()
Dim lastrow As Long, x As Long, y As Long

lastrow = Cells(rows.Count, "A").End(xlUp).Row 'find last row in column A
For x = 1 To lastrow
    'If Cells(x, 1).Value <> ActiveCell.Value Then 'Check if cell in column A contains the same value as the activated cell
        For y = x + 1 To lastrow
            If Cells(y, 1).Value = Cells(x, 1).Value Then 'Compares cell against each value in column A. If there is a match, the do the following:
                If Cells(y, 6).Value <> "UPGRADE" Then 'Checks if duplicate value contains "UPGRADE"
                    Cells(x, 10).Value = Cells(y, 6).Value 'If this value is found, copy the value of the duplicate program name into a specified column for that program type in row x.
                'Else
                    'Cells(x, 12).Value = Cells(y, 12).Value 'If the value is not found, copy the program type into a separate column for that program type in row x.
                End If
            End If
        Next y
    'End If
Next x

End Sub

Answer 2

下一个没有for是因为if then count不匹配end if count 在这里，缩进真的很有用。

Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row 
'find last row in column A
For x = 1 To lastrow
    If Cells(x, 1).Value <> ActiveCell.Value Then 
'Check if cell in column A contains the same value as the activated cell 
        For y = 1 To lastrow
            If Cells(y, 1).Value = Cells(x, 1).Value Then 
'Compares cell against each value in column A. If there is a match, the do the following:
                If Cells(y,6).Value <> "UPGRADE" Then 
'Checks if duplicate value contains "UPGRADE"
                    Cells (x,10).Value= Cells(y,10).Value 
'If this value is found, copy the value of the duplicate program name into a specified column for that program type in row x.
                Else Cells(x,12).Value=Cells(y,12).Value 
'If the value is not found, copy the program type into a separate column for that program type in row x.
                End If
'I inserted another end if here
            end if
        Next y
   End If
Next x