VBA单一选择&复制(从最后一个单元格到带有数据的最后一个单元格)给出“对象_Global ...”的“方法'范围'”

时间:2016-09-29 07:01:46

标签: excel vba excel-vba excel-2013

我的代码的目的是:

  • 清理两个目标列

  • 在源工作表中跳转到特定列中的最后一个单元格(1048576) 从底部,跳转到带有数据的最后一个单元格,然后从那里选择 到顶部单元格

  • 复制,粘贴和删除重复项(removeduplicates是有效的 部分)

我必须从底部选择范围,因为嵌入的空单元格会阻止excel选择带有数据的其他单元格。

执行选择的行在多次检查后似乎是正确的,并且还尝试

  • 使用字符串形式(“AC”)作为参数
  • 数字表格(13)
  • 将单元格编号放在Range()

尽管我付出了很多努力,但该行给出了“运行时错误'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

欢迎任何帮助/建议/其他任务解决方案。 提前谢谢。

1 个答案:

答案 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