Question

第一次发布在这里，但发现该网站过去非常有用。

我已经编写了一个宏来将数据从一个工作表复制到另一个工作表，在两列上排序A-＆gt; Z然后删除重复的条目，然后再应用一些格式。它在几周前工作，但由于我决定用已定义的工作表和范围替换。选择语句（从我已阅读的内容中考虑好的做法），因此已停止工作。

目前，我在以下行中收到运行时1004错误（应用程序定义或对象定义错误）：

desMdWs.Range("A6:D" & (Range("A" & Rows.Count).End(xlUp).Row)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

以下完整子代码：

Sub UpdateMasterDataList(resWs, mdWs, estWs)
'
' UpdateMasterDataList Macro
' Updates the ATC Master Data tab with any new exceptions found
'
'
' Copy unique values from ATC results list to Remediation Master Data list
'
Dim srcWs As Worksheet
Dim srcRng As Range
Dim desMdWs As Worksheet
Dim desMdRng As Range
Dim desEstWs As Worksheet
Dim desEstRng As Range
Dim LastRow As Long
' Define worksheets to copy from and to
Set srcWs = resWs
Set desMdWs = mdWs
Set desEstWs = estWs
' Define cell ranges to copy from and to
Set srcRng = srcWs.Range("B2:C" & (Range("B" & Rows.Count).End(xlUp).Row))
Set desMdRng = desMdWs.Range("A" & (Range("A6").End(xlDown).Offset(1).Row))
Set desEstRng = desEstWs.Range("A8")

' Perform copy and paste
'Dim srcArray() As Variant
'srcArray = Range("srcRng")
'Dim i As Long
'For i = LBound(srcArray, 1) To UBound(srcArray, 1)
'    Debug.Print "srcRng = " & srcArray(i, 1)
'Next
'
'For Each strval In desMdRng
'    Debug.Print "desMdRng = " & desMdRng.Value
'Next
srcRng.Copy
desMdRng.PasteSpecial Paste:=xlPasteValues

'
' Sort the list A-Z
'
'desMdWs.Range ("A3:B" & (Range("B" & Rows.Count).End(xlUp).Row)) 'not needed
desMdWs.Sort.SortFields.Clear
desMdWs.Sort.SortFields.Add Key:= _
    Range("A6:A" & (Range("A" & Rows.Count).End(xlUp).Row)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
desMdWs.Sort.SortFields.Add Key:= _
    Range("B6:B" & (Range("B" & Rows.Count).End(xlUp).Row)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With desMdWs.Sort
    .SetRange Range("A6:B" & (Range("B" & Rows.Count).End(xlUp).Row))
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'
' Remove duplicates from the list
'
desMdWs.Range("A6:D" & (Range("A" & Rows.Count).End(xlUp).Row)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
'
' Autofit the columns
'
desMdWs.Columns("A:A").EntireColumn.AutoFit
desMdWs.Columns("B:B").EntireColumn.AutoFit
'
' Add borders
'
Dim desMdTab As Range
Set desMdTab = desMdWs.Range("A6:D" & (Range("A" & Rows.Count).End(xlUp).Row))
desMdTab.Borders(xlDiagonalDown).LineStyle = xlNone
desMdTab.Borders(xlDiagonalUp).LineStyle = xlNone
With desMdTab.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With desMdTab.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With desMdTab.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With desMdTab.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With desMdTab.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With desMdTab.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
desMdWs.Range("D7").AutoFill Destination:=desMdWs.Range("D" & (Range("D" & Rows.Count).End(xlUp).Offset(1).Row) & ":D" & (Range("A" & Rows.Count).End(xlUp).Row)), Type:=xlFillDefault
End Sub

如果有人能够发现我出错的地方，我们将不胜感激。

干杯，詹姆斯

Answer 1

您的Range("A" & Rows.Count).End(xlUp).Row未指定其工作表，这就是VBA未找到它的原因。

尝试

desMdWs.Range("A" & Rows.Count).End(xlDown).Row

使用xlDown而不是up，这将为您提供最后一个非空行。（从我收集的内容来看，xlDown相当于ctrl + down）

使用Range.RemoveDuplicates时的运行时1004

1 个答案: