excel 函数存在“需要对象”问题,如果将其作为子函数,则运行正常

jq6vz3qz  于 2023-06-07  发布在  其他
关注(0)|答案(3)|浏览(225)

编辑:调用函数添加到代码底部
我写了一段代码,它查看两个单独的工作簿,并比较它们之间的数据,以从其中一个工作簿中删除重复的数据。这段代码作为一个子程序工作得非常好,但是我希望它作为一个函数工作,这样我也可以为其他工作簿调用它。当我把它作为一个函数运行时,我得到一个'object required'错误,但我不能确定从哪里来的。我所做的唯一更改是从代码中删除变量并将其放入标题中(不确定其官方名称是什么,但数据与标题在同一行)。在下面的代码中,我把变量当作一个sub来引用,但是当作为函数运行时,它们被删除了。你知道错误可能来自哪里吗?

Public Function removedupes(wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet, month As Range, cell As Range)
    
    On Error Resume Next
    'define variables
    'Dim wb1 As Workbook
    'Dim wb2 As Workbook
    'Dim ws1 As Worksheet
    'Dim ws2 As Worksheet
    Dim itemmatch As Range
    'Dim cell As Range
    'Dim month As Range
    Dim firstmatch As String
    Dim item As Long
     
    'Set wb1 = Workbooks("workbook 1")
    'Set wb2 = Workbooks("workbook 2")
    'Set ws1 = wb1.Worksheets("sheet 1")
    'Set ws2 = wb2.Worksheets("sheet 2")
    'Set month = ws1.Range("A:A")

    'finds matching item numbers
    With month
    'Set cell = ws2.Range("B3")
    Do Until cell.Value = 0
    item = cell.Value
    Set itemmatch = .Find(item, LookIn:=xlValues, LookAt:=xlPart)
        If Not itemmatch Is Nothing Then
    'deletes dupelicate cells
                itemmatch.Resize(1, 12).Delete shift:=xlUp
                Set cell = cell.Offset(1, 0)
                item = cell.Value
        Else
            Set cell = cell.Offset(1, 0)
        End If
    Loop
    End With
    
    End Function

这就是我调用函数的方式:

removedupes Workbooks("workbook 1"), Workbooks("workbook 2"), wb1.Worksheets("worksheet 1"), wb2.Worksheets("worksheet 2"), ws1.Range("A:A"), ws2.Range("B3")
plicqrtu

plicqrtu1#

我想我知道为什么会这样了。
这就是你需要如何调用你的函数/子例程

Dim wb1 As Workbook
  Dim wb2 As Workbook
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim month As Range
  Dim cell As Range
  
  Set wb1 = Workbooks("workbook 1")
  Set wb2 = Workbooks("workbook 2")
  Set ws1 = wb1.Sheets("worksheet 1")
  Set ws2 = wb2.Sheets("worksheet 2")
  Set month = ws1.Range("A:A")
  Set cell = ws2.Range("B3")
  removedupes wb1, wb2, ws1, ws2, month, cell

如果你不想声明变量,那么你可以这样调用它:

removedupes Workbooks("workbook 1"), _
            Workbooks("workbook 2"), _
            Workbooks("workbook 1").Sheets("worksheet 1"), _
            Workbooks("workbook 2").Sheets("worksheet 2"), _
            Workbooks("workbook 1").Sheets("worksheet 1").Range("A:A"), _
            Workbooks("workbook 2").Sheets("worksheet 2").Range("B3")

不能使用函数参数在调用语句中定义另一个参数。

  • 请注意 * _是VBA中的行连续字符。它允许我们将一长行拆分为多行以提高可读性。

顺便说一下,在你的函数中,你需要传递的是cellmonth变量。因此,您的函数可以简化为:

Public Function removedupes(month As Range, cell As Range)
    On Error Resume Next
    'define variables
    Dim itemmatch As Range
    Dim firstmatch As String
    Dim item As Long

    'finds matching item numbers
    With month
      Do Until cell.Value = 0
          item = cell.Value
          Set itemmatch = .Find(item, LookIn:=xlValues, LookAt:=xlPart)
          If Not itemmatch Is Nothing Then
              'deletes dupelicate cells
              itemmatch.Resize(1, 12).Delete shift:=xlUp
              Set cell = cell.Offset(1, 0)
              item = cell.Value
          Else
              Set cell = cell.Offset(1, 0)
          End If
      Loop
    End With
End Function

你可以这样称呼它:

removedupes Workbooks("workbook 1").Sheets("worksheet 1").Range("A:A"), _
            Workbooks("workbook 2").Sheets("worksheet 2").Range("B3")
acruukt9

acruukt92#

以任何测试工作簿为例(在我的例子中是“Map3”),在ThisWorkbook中有以下内容:

Sub test()
    Dim wb As Workbook: Set wb = Workbooks("other")
    Dim ws As Worksheet: Set ws = wb.Sheets(1)
    Dim rngMonth As Range: Set rngMonth = ws.Range("A1:A10")
    Dim rngCell As Range: Set rngCell = ActiveSheet.Range("B2")
    Application.Run "PERSONAL.XLSB!removedupes", ActiveWorkbook, wb, ActiveSheet, ws, rngMonth, rngCell
End Sub

然后,您可以将sub removedupes保存在您的个人文件中,并像上面的代码中那样调用它,同时能够传递sub中定义的变量。
个人方面:

Sub removedupes(wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet, month As Range, cell As Range)

    On Error Resume Next
    Dim itemmatch As Range
    Dim firstmatch As String
    Dim item As Long
    
    'finds matching item numbers
    With month
    'Set cell = ws2.Range("B3")
    Do Until cell.Value = 0
    item = cell.Value
    Set itemmatch = .Find(item, LookIn:=xlValues, LookAt:=xlPart)
        If Not itemmatch Is Nothing Then
    'deletes dupelicate cells
                itemmatch.Resize(1, 12).Delete shift:=xlUp
                Set cell = cell.Offset(1, 0)
                item = cell.Value
        Else
            Set cell = cell.Offset(1, 0)
        End If
    Loop
    End With

End Sub

我在“其他”中的所有内容都与在“Map3”中的相同,并让它运行一次:

我希望这就是你要找的:)
P.S.:您也可以通过VBE中的工具将引用添加到您的个人工作簿中,但这种方式当然是最快的。

iyfamqjs

iyfamqjs3#

编辑Notus_Panda的评论,我在调用removedupes子程序的子程序中设置变量,然后从同一个子程序中调用变量。我不再得到对象所需的错误,并已测试了它与其他工作簿以及。谢谢大家!
调用变量的sub如下所示。

Public Sub test()

Dim wb1 As Workbook: Set wb1 = Workbooks("workbook 1")
Dim wb2 As Workbook: Set wb2 = Workbooks("workbook 2")
Dim ws1 As Worksheet: Set ws1 = wb1.Worksheets("worksheet 1")
Dim ws2 As Worksheet: Set ws2 = wb2.Worksheets("worksheet 2")
Dim month As Range: Set month = ws1.Range("A:A")
Dim cell As Range: Set cell = ws2.Range("B3")
removedupes wb1, wb2, ws1, ws2, month, cell
End Sub

removedupes sub的代码如下所示。

Public Sub removedupes(wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet, ws2 As Worksheet, month As Range, cell As Range)

On Error Resume Next
Dim itemmatch As Range
Dim firstmatch As String
Dim item As Long
'finds matching item numbers
With month
Do Until cell.Value = 0
item = cell.Value
Set itemmatch = .Find(item, LookIn:=xlValues, LookAt:=xlPart)
    If Not itemmatch Is Nothing Then
'deletes dupelicate cells
            itemmatch.Resize(1, 12).Delete shift:=xlUp
            Set cell = cell.Offset(1, 0)
            item = cell.Value
    Else
        Set cell = cell.Offset(1, 0)
    End If
Loop
End With

End Sub

相关问题