0

これは VBA スクリプトです。私のコレクションが [マーケット別] シートに表示されない理由がわかりません。

Sub ArrayPractice()

Dim r As Integer
Dim i As Integer
Dim a As Integer
Dim numberOfRows As Integer
Dim names() As String
Dim resourceCollect As Collection

Dim Emp As Resource
Dim Count As Long

Set resourceCollect = New Collection

a = Worksheets("DATA").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
r = 2 'row that i start looping from
i = 0

For Each Emp In resourceCollect

For Count = 0 To a
Emp.Name = Cells(r, 1).Value
Emp.Title = Cells(r, 2).Value
Emp.City = Cells(r, 3).Value
resourceCollect.Add Emp
r = r + 1
Next Count
Next Emp

''''print the array!''''

Sheets.Add.Name = "By Market"
Sheets.Add.Name = "By Resource Level"
Sheets.Add.Name = "By Resource Manager"



Sheets("By Market").Select
Range("C36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Dallas" Then
Cells(r, 3).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

Range("D36:D36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Denver" Then
Cells(r, 4).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

Range("E36:E36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Houston" Then
Cells(r, 5).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

Range("F36:F36").Select
r = 36
For Each Emp In resourceCollect
If Emp.City = "Kansas City (Missouri)" Then
Cells(r, 6).Select
Debug.Print Emp.Name
r = r - 1
End If
Next Emp

End Sub

アップデート

ジョセフの答えに従って、これが私が試したことです。まだ機能していません。

これが私がいじっているいくつかの異なるサブです。それらはすべて同じ問題を達成しようとしています。

Sub stackResources()

Dim c As New Collection

Dim r1 As Excel.Range 'an object
Dim r2 As Excel.Range
Dim r3 As Excel.Range


Set r1 = Range("A1")
Set r2 = Range("B1")
Set r3 = Range("C1")

c.Add r1
c.Add r2
c.Add r3

Sheets("By Market").Select
Range("A1").Select

Dim i As Long
For i = 1 To c.Count
    Debug.Print c.Item(i)
    Next


End Sub

Sub collectionTest()
Dim c As New Collection

Dim emp As Resource


Sheets("DATA").Select

Range("A1").Select

Do Until Selection.Value = ""
    emp.name = Selection.Value
        ActiveCell.Offset(0, 1).Select
    emp.Title = Selection.Value
        ActiveCell.Offset(0, 1).Select
    emp.city = Selection.Value
        c.Add emp

    Loop


Sheets("By Market").Select
Range("A1").Select

Dim i As Long
For i = 1 To c.Count
    Debug.Print c.Item(i)
    Next




End Sub

Sub printACollection()

Dim c As New Collection

Dim s1 As String
Dim s2 As String
Dim s3 As String

Sheets("DATA").Select

Dim r As Long


r = 1
For Each cell In Range("A1")
    s1 = cell.Value
    c.Add s1
    ActiveCell.Offset(0, 1).Select
    s2 = cell.Value
    c.Add s2
    ActiveCell.Offset(0, 1).Select
    s3 = cell.Value
    c.Add s3
    Next


    Sheets("By Market").Select

      Dim i As Long

    For i = 1 To c.Count
        Debug.Print c.Item(i)
    Next



End Sub
4

2 に答える 2

2

何が起こっているかというresourceCollectと、何も入っていないので、実際には何もループしていません。コレクションをループするには、コレクションにアイテムを追加する必要があります。

役立つ基本的なチュートリアルを次に示します。

http://www.wiseowl.co.uk/blog/s239/collections.htm

編集：あなたのコメントに答えるには：

Public Sub test()
    Dim c As New Collection

    Dim s1 As String
    Dim s2 As String
    Dim s3 As String

    s1 = "hello"
    s2 = ","
    s3 = "world"

    c.Add s1
    c.Add s2
    c.Add s3

    Dim s As String

    For Each s In c
        Debug.Print s
    Next
End Sub

String データ型を使用してループスルーできないため、これは失敗します...それは単なるデータ型であり、オブジェクトではないためです。この場合、インデックス (インデックス?) をループする必要があります。

    Dim i As Long

    For i = 1 To c.Count
        Debug.Print c.Item(i)
    Next

ただし、Range などの VBA で認識されているオブジェクトを使用する場合は、次のようになります。

Public Sub test2()
    Dim c As New Collection

    Dim r1 As Excel.Range ' an object
    Dim r2 As Excel.Range

    Set r1 = Range("A1")
    Set r2 = Range("A3")

    c.Add r1
    c.Add r2

    Dim r As Excel.Range
    For Each r In c
        Debug.Print r.Address
    Next r
End Sub

これで問題なく動作します。

カスタム クラスを使用している場合は、Range オブジェクトで行ったように、オブジェクトを使用してコレクションをループできます。私が参照するリンクは、発生する可能性のある問題と、独自の Collection オブジェクトを作成する解決策について説明しています。

于 2013-04-15T19:44:34.323 に答える
1

これがあなたのコメントに基づく別の答えです。これがあなたが探しているものだと思います。そうでない場合は、より説明的になり、質問を変更してください。

次のコードを持つ Employee というクラス モジュールがあります。

Option Explicit

Public Name As String
Public City As String
Public Title As String

次に、通常のモジュールでは、次のようなものを使用できます。例に細心の注意を払い、必要に応じて変更してください。自分で試してみることができるように、Sort コードは省略しました。また、作業を個別の関数/サブに分割する方法にも注目してください。これにより、コードがクリーンになり、追跡しやすくなります。お役に立てれば。

Option Explicit

Public Sub main()
    Application.ScreenUpdating = False

    Dim c As Collection
    Dim newWs As Excel.Worksheet
    Dim rData As Excel.Range

    Set rData = ThisWorkbook.Sheets("Sheet1").Range("A2:C3")

    Set c = getData(rData)
    Set newWs = ThisWorkbook.Worksheets.Add

    newWs.Name = "New report"

    Call putCollectionInWorksheet(newWs, c)

    Call sortData(newWs)

    Application.ScreenUpdating = True
End Sub

Private Function getData(ByRef rng As Excel.Range) As Collection
    ' create new collection of data
    Dim c As New Collection
    Dim i As Long
    Dim e As Employee
    For i = 1 To rng.Rows.Count
        Set e = New Employee

        e.Name = rng.Cells(i, 1) ' name column
        e.Title = rng.Cells(i, 2) ' title column
        e.City = rng.Cells(i, 3) ' city column

        c.Add e
    Next i

    Set getData = c
End Function

Private Sub putCollectionInWorksheet(ByRef ws As Excel.Worksheet, ByRef cData As Collection)
    Dim i As Long, j As Long
    Dim emp As Employee

    ' create header info
    ws.Range("A1:C1") = Array("Name", "Title", "City")
    i = 2 ' current row

    For Each emp In cData
        ws.Cells(i, 1).Value = emp.Name
        ws.Cells(i, 2).Value = emp.Title
        ws.Cells(i, 3).Value = emp.City

        i = i + 1
    Next emp
End Sub

Private Sub sortData(ByRef ws As Excel.Worksheet)
    ' code here
End Sub
于 2013-04-17T16:10:12.347 に答える