-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 では、「選択したセル」を範囲変数として使用しましたが、それをどのように渡すつもりだったのかわかりません。また、新しいシートを作成します。に、シート名が一意になるように小さなコードを追加しました。

クラス：

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

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

美容師はここで見つけることができます。(Web サイトは 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 に答える