需要对以下代码进行一些更改 [英] Need some changes to the below code

问题描述

这是Reafidy的一个程序员在stackoverflow上提出的代码。它按照预期工作。 需要更好的优化代码？
现在我必须重新使用相同的代码为大文件。

  Sub Delete_Duplicate_Codes（）
 ThisWorkbook.Worksheets（Data）。激活
 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]这些意思是连接A，B，F，G，H，I和I已经相应地改变了
 vData = .Resize（，1）.Value 
 End With 
 ReDim vArray（1 To UBound（vData，1），0）
使用CreateObject（Scripting.Dictionary）
对于lRow = 1对于UBound（vData，1）
如果不是.exists（vData（lRow， 1））然后
 vArray（lRow，0）=x
 .Add vData（lRow，1），Nothing 
 End If 
 Next lRow 
 End With 
 Application.ScreenUpdating = False 
使用ActiveSheet 
 .Range（BB3）。调整大小（UBound（vArray，1））= vArray 
在Erro r 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'抛出错误
结束
 Application.ScreenUpdating = True 
 End Sub 
  

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

  .Columns（52）.Resize（，2）.ClearContents 
  

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

我已经更改了

  .FormulaR1C1 = = RC [-24]& RC [-23]& RC [-19]& RC [-18]& RC [-17]& RC [-16]这些到
。公式R1C1 == RC [-52]& RC [-51]& RC [-47]& RC [-46]& RC [-45]& RC [-44]这些
  

我想这一定是正确的

解决方案

你几乎有了，应该是：

  .Columns（53）.Resize（，2） .ClearContents 
  

但是我看不出它会如何抛出错误。

如果你不喜欢R1C1符号，你可以使用：

 使用ActiveSheet。范围（A3，Cells（Rows.Count，A）。End（xlUp））Offset（，52）
 .Formula == A3&B3& F3&G3& H3& I3
 vData = .Resize（，1）.value 
结束
  

你应该也留下空间，它有助于阅读。

作为变量，vArray As Variant
Dim lRow As Long

使用ActiveSheet.Range（ A3，Cells（Rows.Count，A）。End（xlUp））Offset（，52）
.Formula == A3&B3&F3&G3& H3& I3
vData = .Resize（，1）.value
结束

ReDim vArray（1到UBound（vData，1），0）
使用CreateObject（Scripting.Dictionary ）
对于lRow = 1到UBound（vData，1）
如果不是.exists（vData（lRow，1））然后
vArray（lRow，0）=x
。添加vData（lRow，1），Nothing
结束If
下一页lRow
结束

Application.ScreenUpdating = False

使用ActiveSheet
.Range（BB3）。调整大小（UBound（vArray，1））= vArray
On Error Resume Next
.Range（BA34274，.Cells（Rows.Count ，BA）。End（xlUp））。Offset（，1）.SpecialCells（xlCellTypeBlanks）.EntireRow.Delete
错误GoTo 0
.Columns（53）.Resize（，2）.ClearContents
结束

Application.ScreenUpdating = True
End Sub

This was the code suggested by Reafidy a programmer on stackoverflow. it was working as intended. Need a better optimized code? Now I have to Re-use the same code for a large file.

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

He helped me and we have used y and z columns for these purpose Now I have to use BA and BB columns for these task. I dont understand where to make the changes. I replaced z with "BB" and y with "BA" columns but its throwing an error application-defined or object-defined at these line

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

where I have to make changes and the top 1 and 2 rows are used for headers. The cells starts from 3rd row. Please help me with these code. any help is greatly appreciated

I have changed

 .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

I guess it must be right

解决方案

You almost had it, it should be:

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

But I don't see how it could have thrown an error.

Also if you dont like the R1C1 notation you can just use:

  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

You should also leave the spaces, it helps with readability.

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

这篇关于需要对以下代码进行一些更改的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！