-4

这个简短的脚本在“下一步”中断。我想将此数据保存在一个集合中，以便我可以转储和自定义它在工作簿中的呈现方式。谢谢你的帮助

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

资源类

''''''''''''''''''''''
' 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
4

4 回答 4

2

我稍微修改了 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
于 2013-04-12T10:10:02.990 回答
1 
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
于 2013-04-05T19:36:25.773 回答
1

看起来您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
于 2013-04-09T12:34:37.250 回答
1

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

美化器可以在这里找到。（该网站只显示到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()

于 2013-04-09T13:01:35.070 回答