【问题标题】:How to find duplicate values in a column and copy paste the rows found duplicated [VBA]如何在列中查找重复值并复制粘贴发现重复的行 [VBA]
【发布时间】:2019-10-21 23:29:56
【问题描述】:

问题是第一列有重复值(金融产品的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 环境中工作的任何精算师或风险经理有所帮助。

【问题讨论】:

  • Copy 是问题所在。它很慢。此外,应避免使用Activate,但您需要始终告诉 VBA 您指的是哪个工作表。
  • 两者都同意。我可以使用而不是只复制等式。我使用了激活,因为之前还有其他代码使用其他工作表运行。

标签: excel vba duplicates copy copy-paste


【解决方案1】:

改变了一些东西。如前所述,CopyActivate 是对性能的最大拖累。我引入了With 语句而不是Activate,并将CopyPaste 更改为更快的....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

因为如果您在开始时禁用这些功能,然后突然代码出现问题,您可能无法重新启用这些功能。

【讨论】:

  • 我明白了,我将合并这些更改以查看差异。现在代码在 8 分钟内运行。谢谢。
  • 借助 Nick 和您的更改,我们设法在 1 分 16 秒内运行代码!非常感谢大家。
【解决方案2】:

在不改变你所做的任何事情的情况下(毕竟你说它有效),你可以在调用你的 sub 之前尝试禁用 Excel 的一些自动功能:

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

然后在您从潜艇返回时重新启用它们:

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

希望您这样做可以提高执行速度

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2017-07-04
    • 2017-12-16
    • 1970-01-01
    • 1970-01-01
    • 2019-01-22
    • 1970-01-01
    • 2018-10-14
    相关资源
    最近更新 更多