Question

这是由stackoverflow上的程序员Reafidy提出的代码。它按预期工作。 Need a better optimized code? 现在我必须为大文件重用相同的代码。

Sub Delete_Duplicate_Codes()  
ThisWorkbook.Worksheets("Data").Activate
Dim vData As Variant, vArray As Variant
Dim lRow As Long
    With ActiveSheet.Range("A3", Cells(Rows.Count, "A").End(xlUp)).Offset(, 52)
        .FormulaR1C1 = "=RC[-24]&RC[-23]&RC[-19]&RC[-18]&RC[-17]&RC[-16]" ' I know what these meant concatenate A,B,F,G,H,I and I have changed it accordingly
        vData = .Resize(, 1).Value
    End With
ReDim vArray(1 To UBound(vData, 1), 0)
    With CreateObject("Scripting.Dictionary")
        For lRow = 1 To UBound(vData, 1)
            If Not .exists(vData(lRow, 1)) Then
                vArray(lRow, 0) = "x"
                .Add vData(lRow, 1), Nothing
            End If
        Next lRow
    End With
Application.ScreenUpdating = False
    With ActiveSheet
        .Range("BB3").Resize(UBound(vArray, 1)) = vArray
        On Error Resume Next
        .Range("BA34274", .Cells(Rows.Count, "BA").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
        .Columns(52).Resize(, 2).ClearContents ' throwing an error
    End With
Application.ScreenUpdating = True
End Sub

他帮助了我，我们使用了y和z列用于这些目的现在我必须使用BA和BB列来完成这些任务。我不明白在哪里做出改变。我用“BB”替换了z，用“BA”列替换了y，但它在这些行中抛出了应用程序定义或对象定义的错误

     .Columns(52).Resize(, 2).ClearContents

我必须进行更改，前1行和2行用于标题。细胞从第3行开始。请帮我这些代码。非常感谢任何帮助

我已经改变了

 .FormulaR1C1 = "=RC[-24]&RC[-23]&RC[-19]&RC[-18]&RC[-17]&RC[-16]"  these to
  .FormulaR1C1 = "=RC[-52]&RC[-51]&RC[-47]&RC[-46]&RC[-45]&RC[-44]" these

我猜它一定是对的

Answer 1

你几乎拥有它，它应该是：

.Columns(53).Resize(, 2).ClearContents

但我不知道它是如何引发错误的。

另外，如果你不喜欢R1C1表示法，你可以使用：

  With ActiveSheet.Range("A3", Cells(Rows.Count, "A").End(xlUp)).Offset(, 52)
        .Formula = "=A3&B3&F3&G3&H3&I3"
        vData = .Resize(, 1).value
  End With

你也应该留空间，这有助于提高可读性。

Sub Delete_Duplicate_Codes()
    Dim vData As Variant, vArray As Variant
    Dim lRow As Long

    With ActiveSheet.Range("A3", Cells(Rows.Count, "A").End(xlUp)).Offset(, 52)
        .Formula = "=A3&B3&F3&G3&H3&I3"
        vData = .Resize(, 1).value
    End With

    ReDim vArray(1 To UBound(vData, 1), 0)
    With CreateObject("Scripting.Dictionary")
        For lRow = 1 To UBound(vData, 1)
            If Not .exists(vData(lRow, 1)) Then
                vArray(lRow, 0) = "x"
                .Add vData(lRow, 1), Nothing
            End If
        Next lRow
    End With

    Application.ScreenUpdating = False

    With ActiveSheet
        .Range("BB3").Resize(UBound(vArray, 1)) = vArray
        On Error Resume Next
        .Range("BA34274", .Cells(Rows.Count, "BA").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
        .Columns(53).Resize(, 2).ClearContents
    End With

    Application.ScreenUpdating = True
End Sub

需要对以下代码进行一些更改

1 个答案: