Question

我正在尝试从工作表输入中选择列E和K，在Working sheet中处理并在最后一次使用的行之后粘贴Output sheet。我已将最后使用的行号存储在x中，并将值粘贴到x + 1单元格中。但excel选择工作表的最后一行（x为65536）并给出运行时错误4004.有人可以帮助我协助代码。

Dim x As Long, y As String
    Sheets("Input").Activate
    Range("E:E,K:K").Select
    Range("K1").Activate
    Selection.Copy
    Sheets("Working").Select
    Cells(1, 1).Select
    ActiveSheet.Paste
    Cells.Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("B5").Select
    ActiveSheet.Range("$A$1:$H$30").AutoFilter Field:=1, Criteria1:="="
    Cells.Select
    Selection.Delete Shift:=xlUp
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",VLOOKUP(RC[-1],Repository!C[-1]:C[1],3,0))"
    Range("B2").Select
    Selection.Copy
    Range("B3:B30").Select
    ActiveSheet.Paste
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Output").Select
    Range("A1").Select
    x = Worksheets("Output").UsedRange.Rows.Count
    y = "a" & Trim(x + 1)
    ActiveSheet("Output").Range(y).Select
    ActiveSheet.Paste

Answer 1

您的UsedRange仍然认为最后一行是65536.添加此子例程，然后在设置x之前立即调用它。

Sub CorrectUsedRange()
Dim values
Dim usedRangeAddress As String
Dim r As Range
'Get UsedRange Address prior to deleting Range
usedRangeAddress = ActiveSheet.UsedRange.Address
'Store values of cells to array.
values = ActiveSheet.UsedRange
'Delete all cells in the sheet
ActiveSheet.Cells.Delete
'Restore values to their initial locations
Range(usedRangeAddress) = values
End Sub

Answer 2

在代码底部附近替换：

Sheets("Output").Select

使用：

Sheets("Output").Select
ActiveSheet.UsedRange

这应该“重新设置”UsedRange

Answer 3

有时候，使用范围会变得非常大，并且不会自行重置。当发生这种情况时，我发现强制它正确重置的唯一方法是保存主题工作表所在的工作簿。这对我来说无论如何都适用于Excel 2010。由于您使用的是.Select和Active<obj>（我不建议这样做），因此就是这样：

ActiveWorkbook.Save

Answer 4

我会使用Find循环来填充数组，然后在宏完成时输出数组。不需要“工作”表。这也使用Cells(Rows.Count, "A").End(xlUp)来查找最后填充的行而不是UsedRange.Rows.Count，这可能是不可靠的。

Sub tgr()

    Dim rngFound As Range
    Dim rngLookup As Range
    Dim arrResults() As Variant
    Dim ResultIndex As Long
    Dim strFirst As String

    With Sheets("Input").Columns("E")
        Set rngFound = .Find("*", .Cells(.Cells.Count), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            strFirst = rngFound.Address
            ReDim arrResults(1 To WorksheetFunction.CountA(.Cells), 1 To 2)
            Do
                If rngFound.Row > 1 Then
                    ResultIndex = ResultIndex + 1
                    On Error Resume Next    'Just in case the VLookup can't find the value on the 'Repository' sheet
                    arrResults(ResultIndex, 1) = Evaluate("VLOOKUP(""" & rngFound.Value & """,Repository!A:C,3,FALSE)")
                    arrResults(ResultIndex, 2) = .Parent.Cells(rngFound.Row, "K").Value
                    On Error GoTo 0         'Remove the On Error Resume Next condition
                End If
                Set rngFound = .Find("*", rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
        End If
    End With

    If ResultIndex > 0 Then Sheets("Output").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(ResultIndex, UBound(arrResults, 2)).Value = arrResults

    Set rngFound = Nothing
    Erase arrResults

End Sub

Answer 5

而不是使用范围检查已使用此代码填充了多少行：

X = WorksheetFunction.CountA（Columns（1））

当然，只有在A列中没有空行时才能正常工作，因为这些行会被忽略！

excel vba中的运行时错误。最后使用的范围行选择行65536而不是实际的最后使用范围

5 个答案: