如何在列中查找重复值并复制粘贴发现重复的行 [VBA]

Question

问题是第一列中有重复值（金融产品的ISIN编号），但其他列中有不同的特征（即不同的产品名称，不同的修改持续时间等）哪里应该是相同的特征。

我想找到第一列中已经存在的 ISIN 编号（至少两次），然后从其他列（发现重复值的同一行）中获取特定元素，例如发行人名称，修改持续时间等并将它们粘贴到其他的 ISIN 元素，以便在 ISIN 编号相同的情况下报告相同的元素（其他列中的数据）。我也想比较这些重复产品的修改持续时间并取较大的（出于保守的原因，因为这些数据用于进一步的计算）。

Sub dup_cp()

Dim i As Integer
Dim j As Integer
Dim k As Integer

Sheets("Investment Assets").Activate
j = Application.CountA(Range("A:A")) 
'counts the number of filled in rows

For i = 5 To j
'it starts from line 5 on purpose, the ISIN numbers start from that line
    For k = i + 1 To j
        If Sheets("Investment Assets").Range(Cells(k, 55), Cells(k, 55)).Value = "Duplicate Value" Then GoTo skip_dup 
        'it skips the line that has already been detected as duplicated

        If Sheets("Investment Assets").Range(Cells(k, 1), Cells(k, 1)).Value = Sheets("Investment Assets").Range(Cells(i, 1), Cells(i, 1)).Value Then 
        'it finds the duplicate value (ISIN number) in the first column
            If Sheets("Investment Assets").Range(Cells(k, 29), Cells(k, 29)).Value >= Sheets("Investment Assets").Range(Cells(i, 29), Cells(i, 29)).Value Then 
            'it compares the 29th column values (the modified duration of the components) and keeps the bigger value for prudency reasons
                Sheets("Investment Assets").Range(Cells(k, 15), Cells(k, 32)).Copy
                Sheets("Investment Assets").Range(Cells(i, 15), Cells(i, 32)).PasteSpecial Paste:=xlPasteValues
            Else
                Sheets("Investment Assets").Range(Cells(i, 15), Cells(i, 32)).Copy
                Sheets("Investment Assets").Range(Cells(k, 15), Cells(k, 32)).PasteSpecial Paste:=xlPasteValues
            End If
            Sheets("Investment Assets").Range(Cells(k, 55), Cells(k, 55)).Value = "Duplicate Value"
            'it shows in the 55th column if the ISIN number is duplicated or not
            Sheets("Investment Assets").Range(Cells(i, 55), Cells(i, 55)).Value = "Duplicate Value"
        Else
            Sheets("Investment Assets").Range(Cells(k, 55), Cells(k, 55)).Value = "-"
        End If
skip_dup:
    Next
Next

End Sub

此代码有效，但有点混乱，对此我深表歉意。提前感谢所有愿意花时间让它变得更简单、更快速的人。我认为它会对在 Solvecy II 环境中工作的任何精算师或风险经理有所帮助。

Answer 1

在不改变你所做的任何事情的情况下（毕竟你说它有效），你可以在你打电话给你的子之前尝试禁用 Excel 的一些自动功能：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

然后 re-enabling 他们当你 return 从你的 sub:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

希望您会看到执行速度有所提高

Answer 2

更改了一些内容。如前所述，Copy 和 Activate 是对性能的最大拖累。我引入了 With 语句而不是 Activate 并将 Copy、Paste 更改为更快的 ....Value = ....Value

Sub dup_cp()

Dim i As Integer
Dim j As Integer
Dim k As Integer

With Sheets("Investment Assets")
    j = Application.CountA(.Range("A:A"))
    'counts the number of filled in rows

    For i = 5 To j
    'it starts from line 5 on purpose, the ISIN numbers start from that line
        For k = i + 1 To j
            If .Cells(k, 55).Value = "Duplicate Value" Then GoTo skip_dup
            'it skips the line that has already been detected as duplicated

            If .Cells(k, 1).Value = .Cells(i, 1).Value Then
            'it finds the duplicate value (ISIN number) in the first column
                If .Cells(k, 29).Value >= .Cells(i, 29).Value Then
                'it compares the 29th column values (the modified duration of the components) and keeps the bigger value for prudency reasons
                    .Range(.Cells(i, 15), .Cells(i, 32)).Value = .Range(.Cells(k, 15), .Cells(k, 32)).Value
                Else
                    .Range(.Cells(k, 15), .Cells(k, 32)).Value = .Range(.Cells(i, 15), .Cells(i, 32)).Value
                End If
                .Cells(k, 55).Value = "Duplicate Value"
                'it shows in the 55th column if the ISIN number is duplicated or not
                .Cells(i, 55).Value = "Duplicate Value"
            Else
                .Cells(k, 55).Value = "-"
            End If
skip_dup:
        Next
    Next
End With

End Sub

老尼克的提议在性能上也非常棒，但我会谨慎实施，像这样：

Sub xxx

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    'Your code

ErrorHandler:
    If Err.Number <> 0 Then MsgBox Err.Number & " " & Err.Description
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

因为如果你一开始禁用了那些东西，然后代码突然出了问题，你可能得不到那些东西re-enabled。

如何在列中查找重复值并复制粘贴发现重复的行 [VBA]

How to find duplicate values in a column and copy paste the rows found duplicated [VBA]

excel

vba

copy

copy-paste

duplicates