Question

这个简短的脚本在'Next'处打破。我想将这些数据保存在一个集合中，这样我就可以转储和自定义它在整个工作簿中的显示方式。谢谢你的帮助

编辑：更新了我的代码。仍然遇到问题。

资源类

''''''''''''''''''''''
' Name property
''''''''''''''''''''''
Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property

''''''''''''''''''''''
' City property
''''''''''''''''''''''
Public Property Get City() As String
    City = pCity
End Property
Public Property Let City(Value As String)
    pCity = Value
End Property

''''''''''''''''''''''
' Title property
''''''''''''''''''''''
Public Property Get Title() As String
    Title = pTitle
End Property
Public Property Let Title(Value As String)
    pTitle = Value
End Property

脚本

    Sub searchResources()


Dim a As Range
Dim cell As Variant
Dim Resources As Collection
Dim Emp As Resource
Dim Count As Integer




For Each cell In a.Rows
    If cell.Value = "Dallas" Or cell.Value = "Oklahoma City" Or cell.Value = "Houston" Then
    Set Emp = New Resource
        Emp.City = cell.Value
        cell.Offset(0, -2).Select
        Emp.Title = cell.Value
        cell.Offset(0, -1).Select
        Emp.Name = cell.Value
            Resources.Add Emp


                  End If

Resume Next

For Each Emp In Resources

ActiveWorkbook.Sheets("A").Activate
a.Select
    Debug.Print Emp.Name
    Debug.Print Emp.City
    Debug.Print Emp.Title
Next Emp

End Sub

Answer 1

我稍微修改了CLass（添加了私有变量，并更正了proc。在proc中我使用'Selected Cells'作为我的范围变量，我不知道你打算如何传递它。我也有它创建一张新工作表，并添加了一小段代码以确保我们提供的工作表名称是唯一的。

班级：

Private pName As String
Private pCity As String
Private pTitle As String

''''''''''''''''''''''
' Name property
''''''''''''''''''''''
Public Property Get Name() As String
    Name = pName
End Property
Public Property Let Name(Value As String)
    pName = Value
End Property

''''''''''''''''''''''
' City property
''''''''''''''''''''''
Public Property Get City() As String
    City = pCity
End Property
Public Property Let City(Value As String)
    pCity = Value
End Property

''''''''''''''''''''''
' Title property
''''''''''''''''''''''
Public Property Get Title() As String
    Title = pTitle
End Property
Public Property Let Title(Value As String)
    pTitle = Value
End Property

程序：

Sub searchResources()
Dim a As Range
Dim cell As Range 'As Variant (This is a range)
Dim Resources As Collection
Dim Emp As Resource
Dim Count As Integer
'---------
Dim oWS As Worksheet
Dim iRow As Integer, iTest As Integer
Set Resources = New Collection

'Setting the range to selected range on active sheet for my tests
'Assign your range as you see fit
Set a = Application.Selection


For Each cell In a.Cells
    If cell.Value = "Dallas" Or cell.Value = "Oklahoma City" Or cell.Value = "Houston" Then
    Set Emp = New Resource

        Emp.City = cell.Value
        Emp.Title = cell.Offset(0, -2).Value
        Emp.Name = cell.Offset(0, -1).Value
        Resources.Add Emp
    End If
Next cell

Set oWS = Worksheets.Add(After:=Worksheets(Worksheets.Count))

'create a unique name
iRow = 1
On Error Resume Next 'Turn on error handling
iTest = Len(Worksheets("Resources").Name)
'check for error
If Err.Number <> 0 Then 'Sheet doesn't exist
    oWS.Name = "Resources"
Else
    Do
        iTest = Len(Worksheets("Resources" & iRow).Name)
        If Err.Number <> 0 Then
            oWS.Name = "Resources" & iRow
            Exit Do
        Else
            iRow = iRow + 1
        End If
        DoEvents 'Allows CTRL-BREAK to break execution during the cycle
    Loop
End If
On Error GoTo 0 'Turn off error handling
iRow = 2
oWS.Range("A1").Value = "Name"
oWS.Range("B1").Value = "Title"
oWS.Range("C1").Value = "City"

For Each Emp In Resources
    oWS.Range("A" & iRow) = Emp.Name
    oWS.Range("C" & iRow) = Emp.City
    oWS.Range("B" & iRow) = Emp.Title
    iRow = iRow + 1
Next Emp

End Sub

Answer 2

For Each cell In a.Rows
    If cell.Value = "Dallas" Then
    Set Emp = New Resource
        Emp.City = cell.Value
        cell.Offset(0, -2).Select
        Emp.Title = cell.Value
        cell.Offset(0, -1).Select
        Emp.Name = cell.Value
            Resources.Add Emp

            >> Resume Next

    ElseIf cell.Value = "Oklahoma City" Then
    Set Emp = New Resource
        Emp.City = cell.Value
        cell.Offset(0, -2).Select
        Emp.Title = cell.Value
        cell.Offset(0, -1).Select
        Emp.Name = cell.Value
            Resources.Add Emp

           >> Resume Next

    ElseIf cell.Value = "Houston" Then
    Set Emp = New Resource
        Emp.City = cell.Value
       cell.Offset(0, -2).Select
        Emp.Title = cell.Value
        cell.Offset(0, -1).Select
        Emp.Name = cell.Value
            Resources.Add Emp

         >> Resume  Next

            End If
>>> Next

For Each Emp In Resources

ActiveWorkbook.Sheets("A").Activate
a.Select
    Debug.Print Emp.Name
    Debug.Print Emp.City
    Debug.Print Emp.Title
Next Emp

End If <<<Why here have end if? i think you should delete it, cause it doesnt have IF stand for it


UPDATE

我认为你的剧本太长了，不需要重复同样的

For Each cell In a.Rows
    If cell.Value = "Dallas" or cell.Value = "Oklahoma City" or cell.Value = "Houston" Then
    Set Emp = New Resource
        Emp.City = cell.Value
        cell.Offset(0, -2).Select
        Emp.Title = cell.Value
        cell.Offset(0, -1).Select
        Emp.Name = cell.Value
            Resources.Add Emp
                  End If
else
'based on you want to EXIT FOR or RESUME NEXT
Next

For Each Emp In Resources

ActiveWorkbook.Sheets("A").Activate
a.Select
    Debug.Print Emp.Name
    Debug.Print Emp.City
    Debug.Print Emp.Title
Next Emp

Answer 3

看起来您使用的Resume Next应该使用Next cell，请参阅更正的代码：

Sub searchResources()


Dim a As Range
Dim cell As Variant
Dim Resources As Collection
Dim Emp As Resource
Dim Count As Integer




For Each cell In a.Rows
    If cell.Value = "Dallas" Or cell.Value = "Oklahoma City" Or cell.Value = "Houston" Then
    Set Emp = New Resource
        Emp.City = cell.Value
        cell.Offset(0, -2).Select
        Emp.Title = cell.Value
        cell.Offset(0, -1).Select
        Emp.Name = cell.Value
            Resources.Add Emp


                  End If

Next cell

For Each Emp In Resources

ActiveWorkbook.Sheets("A").Activate
a.Select
    Debug.Print Emp.Name
    Debug.Print Emp.City
    Debug.Print Emp.Title
Next Emp

End Sub

Answer 4

通过美化器运行代码会给我一个提示：没有Next cell对应For Each cell In a.Rows

可以找到美化者here。（该网站仅显示Office 2003，但我在2007年和2010年对其进行了测试，并且运行良好）

美化后的结果代码：

Sub searchResources()

Dim a As Range
Dim cell As Variant
Dim Resources As Collection
Dim Emp As Resource
Dim Count As Integer

For Each cell In a.Rows
    If cell.Value = "Dallas" Or cell.Value = "Oklahoma City" Or cell.Value = "Houston" Then
        Set Emp = New Resource
        Emp.City = cell.Value
        cell.Offset(0, -2).Select
        Emp.Title = cell.Value
        cell.Offset(0, -1).Select
        Emp.Name = cell.Value
        Resources.Add Emp


    End If

    Resume Next

    For Each Emp In Resources

        ActiveWorkbook.Sheets("A").Activate
        a.Select
Debug.Print Emp.Name
Debug.Print Emp.City
Debug.Print Emp.Title
    Next Emp

    End Sub

请注意End Sub未与Sub()声明

对齐

刮取数据工作表并粘贴到单独的工作表

4 个答案: