我的代码的目的是:
清理两个目标列
在源工作表中跳转到特定列中的最后一个单元格(1048576) 从底部,跳转到带有数据的最后一个单元格,然后从那里选择 到顶部单元格
复制,粘贴和删除重复项(removeduplicates是有效的 部分)
我必须从底部选择范围,因为嵌入的空单元格会阻止excel选择带有数据的其他单元格。
执行选择的行在多次检查后似乎是正确的,并且还尝试
尽管我付出了很多努力,但该行给出了“运行时错误'1004':对象'_Global'的方法'范围'失败”错误。
我删除了除了单细胞引用之外的所有其他参数,试图重新排列我的代码并通过其他方式解决。
代码部分
Sheets("Data").Cells(Rows.Count, "AC").End(xlUp).Row
返回包含来自bottom的数据的第一个单元格的值(行号)。那将是选择的结束。 我知道有些部分与描述不符,但它们在错误方面也无关紧要。 (例如,在第17-18行,它选择整个列,但我可以稍后解决。)
这是我的代码,我在有问题的部分旁边发表评论。
Sub CopyUniqueProcList()
Dim ContainWord As String
Dim SrcSheet As Worksheet
Dim DestSheet As Worksheet
Dim TypeRng As Range
Dim TypeRngDest As Range
Dim GrundRng As Range
Dim GrundRngDest As Range
Dim TRD_E As Integer
Dim GRD_E As Integer
Set SrcSheet = Worksheets("Data")
Set DestSheet = Worksheets("lTopTenHelper")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set TypeRng = SrcSheet.Range("AC4")
Set TypeRngDest = DestSheet.Range("A1")
Set TRD_E = DestSheet.Cells(Rows.Count, "A")
Set GrundRng = SrcSheet.Range("AE4")
Set GrundRngDest = DestSheet.Range("D1")
Set GRD_E = DestSheet.Cells(Rows.Count, "D")
TRD_E = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row
GRD_E = DestSheet.Cells(DestSheet.Rows.Count, "D").End(xlUp).Row
Sheets("lTopTenHelper").Range(TypeRngDest, "A" & TRD_E).Clear
Sheets("lTopTenHelper").Range(GrundRngDest, "D" & GRD_E).Clear
If TypeRng.Value <> 0 Then
Range(TypeRng, "AC" & Sheets("Data").Cells(Rows.Count, "AC").End(xlUp).Row).Copy 'Error thrown here
Sheets("lTopTenHelper").Cells(Rows.Count, "A").End(xlUp).Offset(0).PasteSpecial Paste:=xlPasteValues
End If
Sheets("lTopTenHelper").Range(TypeRngDest, "AC" & Sheets("Data").Cells(Rows.Count, "AC").End(xlUp).Row).RemoveDuplicates Columns:=Array(1), Header:=xlNo
If GrundRng.Value <> 0 Then
Range(GrundRng, "AE" & Sheets("Data").Cells(Rows.Count, "AE").End(xlUp).Row).Copy
Sheets("lTopTenHelper").Cells(Rows.Count, "D").End(xlUp).Offset(0).PasteSpecial Paste:=xlPasteValues
End If '6?
Sheets("lTopTenHelper").Range(GrundRngDest, "AE" & Sheets("Data").Cells(Rows.Count, "AE").End(xlUp).Row).RemoveDuplicates Columns:=Array(1), Header:=xlNo
Application.Calculation = xlCalculationAutomatic
Exit Sub
End Sub
欢迎任何帮助/建议/其他任务解决方案。 提前谢谢。
答案 0 :(得分:0)
以下代码将帮助您入门,
Option Explicit
Sub CopyUniqueProcList()
Dim ContainWord As String
Dim SrcSheet As Worksheet
Dim DestSheet As Worksheet
Dim TypeRng As Range
Dim TypeRngDest As Range
Dim GrundRng As Range
Dim GrundRngDest As Range
Dim TRD_E As Long
Dim GRD_E As Long
Set SrcSheet = Worksheets("Data")
Set DestSheet = Worksheets("lTopTenHelper")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set TypeRng = SrcSheet.Range("AC4")
Set GrundRng = SrcSheet.Range("AE4")
With DestSheet
' find last row with data in Column A
TRD_E = .Cells(.Rows.Count, "A").End(xlUp).Row
GRD_E = .Cells(.Rows.Count, "D").End(xlUp).Row
Set TypeRngDest = .Range("A1:A" & TRD_E)
Set GrundRngDest = .Range("D1:D" & GRD_E)
TypeRngDest.Clear
GrundRngDest.Clear
End With
If TypeRng.Value <> 0 Then
SrcSheet.Range("AC4:AC" & SrcSheet.Cells(SrcSheet.Rows.Count, "AC").End(xlUp).Row).Copy
DestSheet.Cells(TRD_E, "A").Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
' you can take it from here ... ?
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
End Sub