需要對下面的代碼進行一些更改

Question

這是由一位程序員Reafidy在stackoverflow上建議的代碼。它按預期工作。 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列這些任務。我不知道在哪裏做出改變。我取代Z，使用「BB」和y與「BA」列，但其引發錯誤應用程序定義的或在這些線

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

其中我必須作出改變和頂部1和2行是對象定義用於標題。細胞從第三排開始。請幫助我使用這些代碼。任何幫助是極大的讚賞

我已經改變

.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