不将数据从“电子邮件”表复制到“新表”的脚本 – 运行时错误:对象所需的错误

我目前正在一个脚本,将从一张表复制一些数据到另一个,但我不断收到以下错误信息:

Run time error: Object required

Set uRng = .Range("F1", .Range("F" & .Rows.Count).End(xlUp))

什么可能导致它?

代码如下:

 Sub Collapse() Dim uRng As Range, cel As Range Dim comps As Variant, comp As Variant, r As Variant, v As Variant 'Dim d As Dictionary '~~> Early bind, for Late bind use commented line Dim d As Object Dim a As String With Emails '~~> Sheet that contains your data Set uRng = .Range("F1", .Range("F" & .Rows.Count).End(xlUp)) End With Set d = CreateObject("Scripting.Dictionary") With d For Each cel In uRng a = Replace(cel.Offset(0, -3), "{", "}") comps = Split(a, "}") Debug.Print UBound(comps) For Each comp In comps If InStr(comp, "Computer") <> 0 _ And Len(Trim(comp)) <= 10 Then '~~> I assumed max Comp# is 99 If Not .Exists(cel) Then .Add cel, comp Else If IsArray(.Item(cel)) Then r = .Item(cel) ReDim Preserve r(UBound(r) + 1) r(UBound(r)) = comp .Item(cel) = r Else r = Array(.Item(cel), comp) .Item(cel) = r End If End If End If Next Next End With For Each v In d.Keys With Sheet2 '~~> sheet you want to write your data to If IsArray(d.Item(v)) Then .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) _ .Resize(UBound(d.Item(v)) + 1) = v .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) _ .Resize(UBound(d.Item(v)) + 1) = Application.Transpose(d.Item(v)) Else .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = v .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = d.Item(v) End If End With Next Set d = Nothing End Sub 

如果你有一个叫做电子邮件的工作表,那么你需要:

 Dim Emails As Worksheet Set Emails = Sheets("Emails") 

靠近你的子顶部。