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

然后从子站点返回时重新启用它们：

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

Old Nick的建议对性能也非常有用，但是我会小心地执行它，就像这样：

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

因为如果一开始就禁用了这些功能，然后突然在代码中出现了问题，则可能无法重新启用这些功能。

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

2 个答案: