Excel에서 VBA를 사용하면 클래스 개체 컬렉션을 반복하여 개체 특성 값을 얻을 수 있습니까?

Question

다음 매크로를 작성했습니다.

Sub createFormFields() 
    ' Declare Variables 
    Dim thisFile As String 
    Dim thisFileDirectory As String 
    Dim thisFilePath As String 
    Dim formFieldsFile As String 
    Dim formFieldsFilePath As String 
    Dim customer As String 
    Dim newFileName As String 
    Dim fileVersion As String 
    Dim fileExtension As String 
    Dim filePath As String 
    Dim currentAsTime As String 
    Dim formFieldsWorkbook As Workbook 
    Dim formFieldsSheet As Object 
    Dim page As String 
    Dim questionText As String 
    Dim questionType As String 
    Dim questionId As String 
    Dim topic1 As String 
    Dim topic2 As String 
    Dim notes As String 
    Dim dateAdded As String 
    Dim questions As Collection 
    Dim oQuestion As New cQuestion 

    ' Activate First Question from YAML_Script_Creator file 
    Range("A27").Activate 

    ' Set questions collection as a new collection 
    Set questions = New Collection 

    ' Begin to Populate oQuestion Objects 
    Do 
     If IsEmpty(ActiveCell) Then 
      Exit Do 
     Else 
      ' Ensure that variables do not carry over from previous question 
      page = "" 
      questionText = "" 
      questionType = "" 
      questionId = "" 
      topic1 = "" 
      topic2 = "" 
      notes = "" 
      dateAdded = "" 
      ' Begin setting variables 
      DoEvents 
       ' Check if page cell is empty 
       If IsEmpty(ActiveCell.Offset(0, 24)) Then 
        page = "" 
       Else 
        page = ActiveCell.Offset(0, 24).Value 
       End If 
       ' Set variables 
       questionText = ActiveCell.Offset(0, 2).Value 
       questionType = ActiveCell.Offset(0, 0).Value 
       questionId = ActiveCell.Offset(0, 1).Value 
       topic1 = ActiveCell.Offset(0, 18).Value 
       topic2 = ActiveCell.Offset(0, 20).Value 
       notes = ActiveCell.Offset(0, 25).Value 
       dateAdded = ActiveCell.Offset(0, 23).Value 

       ' Set values to oQuestion Object from variables 
       oQuestion.page = page 
       oQuestion.questionText = questionText 
       oQuestion.questionType = questionType 
       oQuestion.questionId = questionId 
       oQuestion.topic1 = topic1 
       oQuestion.topic2 = topic2 
       oQuestion.notes = notes 
       oQuestion.dateAdded = dateAdded 

       ' Add oQuestion Object to questions Collection 
       questions.Add oQuestion 

       ' Move down to the next question 
       ActiveCell.Offset(1, 0).Activate 
     End If 
    Loop 


    ' Save Pertenate Data for new Form Fields File from YAML_Script_Creator file 
    customer = Range("B3").Value 
    newFileName = Range("F18").Value 
    fileVersion = Range("F19").Value 
    fileExtension = Range("F20").Value 
    filePath = Range("F21").Value 
    formFieldsFile = customer & newFileName & fileVersion & fileExtension 
    formFieldsFilePath = filePath & formFieldsFile 
    Debug.Print formFieldsFilePath 

    ' If file already exists, delete it 
    If Dir(formFieldsFilePath) <> "" Then 
     Kill (formFieldsFilePath) 
    End If 

    ' Create new form fields file 
    Set formFieldsWorkbook = Workbooks.Add 

    ' Set Active Sheet 
    Set formFieldsSheet = formFieldsWorkbook.ActiveSheet 

    ' Get current time and format it 
    currentAsTime = Format(Now(), "yyyy-MM-dd hh:mm:ss") 

    ' Format new sheet 
    formFieldsSheet.Range("A1") = "Customer:" 
    formFieldsSheet.Range("B1") = customer 
    formFieldsSheet.Range("D1") = "Current as of:" 
    formFieldsSheet.Range("E1") = currentAsTime 

    formFieldsSheet.Range("A3") = "Page" 
    formFieldsSheet.Range("B3") = "Question Text" 
    formFieldsSheet.Range("C3") = "Question Type" 
    formFieldsSheet.Range("D3") = "Question ID" 
    formFieldsSheet.Range("E3") = "Topic 1" 
    formFieldsSheet.Range("F3") = "Topic 2" 
    formFieldsSheet.Range("G3") = "Notes on Question" 
    formFieldsSheet.Range("H3") = "Date Added" 

    ' Make Font Bold 
    formFieldsSheet.Range("A1").Font.Bold = True 
    formFieldsSheet.Range("D1").Font.Bold = True 
    formFieldsSheet.Range("A3").Font.Bold = True 
    formFieldsSheet.Range("B3").Font.Bold = True 
    formFieldsSheet.Range("C3").Font.Bold = True 
    formFieldsSheet.Range("D3").Font.Bold = True 
    formFieldsSheet.Range("E3").Font.Bold = True 
    formFieldsSheet.Range("F3").Font.Bold = True 
    formFieldsSheet.Range("G3").Font.Bold = True 
    formFieldsSheet.Range("H3").Font.Bold = True 

    ' Make Bottom Border Thick 
    formFieldsSheet.Range("A3").Borders(xlEdgeBottom).Weight = xlThick 
    formFieldsSheet.Range("B3").Borders(xlEdgeBottom).Weight = xlThick 
    formFieldsSheet.Range("C3").Borders(xlEdgeBottom).Weight = xlThick 
    formFieldsSheet.Range("D3").Borders(xlEdgeBottom).Weight = xlThick 
    formFieldsSheet.Range("E3").Borders(xlEdgeBottom).Weight = xlThick 
    formFieldsSheet.Range("F3").Borders(xlEdgeBottom).Weight = xlThick 
    formFieldsSheet.Range("G3").Borders(xlEdgeBottom).Weight = xlThick 
    formFieldsSheet.Range("H3").Borders(xlEdgeBottom).Weight = xlThick 

    ' Set Cell Alignments 
    formFieldsSheet.Range("D1").HorizontalAlignment = xlRight 

    ' Set Column Widths 
    formFieldsSheet.Range("A1").ColumnWidth = 15.83 
    formFieldsSheet.Range("B1").ColumnWidth = 36.67 
    formFieldsSheet.Range("C1").ColumnWidth = 24.17 
    formFieldsSheet.Range("D1").ColumnWidth = 25 
    formFieldsSheet.Range("E1").ColumnWidth = 20 
    formFieldsSheet.Range("F1").ColumnWidth = 20 
    formFieldsSheet.Range("G1").ColumnWidth = 49.17 
    formFieldsSheet.Range("H1").ColumnWidth = 15.83 

    ' Activate cell to being writing data to 
    formFieldsSheet.Range("A4").Activate 

    ' Loop through objects in questions collection 
    Dim ques As cQuestion 
    Debug.Print questions.Count 
    For Each ques In questions 
     ' Populate Form Fields 
     ActiveCell = ques.page 
     ActiveCell.Offset(0, 1) = ques.questionText 
     ActiveCell.Offset(0, 2) = ques.questionType 
     ActiveCell.Offset(0, 3) = ques.questionId 
     ActiveCell.Offset(0, 4) = ques.topic1 
     ActiveCell.Offset(0, 5) = ques.topic2 
     ActiveCell.Offset(0, 6) = ques.notes 
     ActiveCell.Offset(0, 7) = ques.dateAdded 
     ' Activate next row for next question 
     ActiveCell.Offset(1, 0).Activate 
    Next ques 

    ' Save and close the workbook 
    ActiveWorkbook.SaveAs fileName:=formFieldsFilePath 
    ActiveWorkbook.Close 

End Sub 

매크로에 데이터를 기록 후, I가 클래스를 작성한 객체에 해당 행의 각 열에서 데이터를 저장 컬렉션에 각 개체를 추가하고, 하나의 엑셀 시트에 행을 간다 새 통합 문서의 새 Excel 시트

그러나 내가 실행중인 문제는 각 개체의 컬렉션을 반복하면서 동일한 데이터를 계속 읽는 것입니다. 컬렉션에는 내부에 34 개의 항목이 있으며 각각 다른 항목이 있습니다. 컬렉션을 반복 할 때 마지막 객체를 반복적으로 읽는 것으로 나타납니다. 내가 디버깅하고 컬렉션의 개수를 출력으로 각 개체가 다르다는 것을 알아. 데이터의

예 나는 읽기 오전 : 아웃의

TextQuestion ques_1234566543 Name null TargetAndBaseline 0 true true true true true true true true true true 0.5 0.2 Identity 1 Income 1  11/29/17 Page1 This is the first question 
TextQuestion ques_1234566544 Name null TargetAndBaseline 1 true true true true true true true true true true 0.5 0.2 Identity 2 Income 2  11/30/17   This is the secondquestion 
TextQuestion ques_1234566545 Name null TargetAndBaseline 2 true true true true true true true true true true 0.5 0.2 Identity 3 Income 3  12/1/17    This is the third question 
TextQuestion ques_1234566546 Name null TargetAndBaseline 3 true true true true true true true true true true 0.5 0.2 Identity 4 Income 4  12/2/17    This is the fourth question 
TextQuestion ques_1234566547 Name null TargetAndBaseline 4 true true true true true true true true true true 0.5 0.2 Identity 5 Income 5  12/3/17    This is the fifth question 
TextQuestion ques_1234566548 Name null TargetAndBaseline 5 true true true true true true true true true true 0.5 0.2 Identity 6 Income 6  12/4/17    This is the sixth question 
TextQuestion ques_1234566549 Name null TargetAndBaseline 6 true true true true true true true true true true 0.5 0.2 Identity 7 Income 7  12/5/17    This is the seventh question 
TextQuestion ques_1234566550 Name null TargetAndBaseline 7 true true true true true true true true true true 0.5 0.2 Identity 8 Income 8  12/6/17    This is the eighth question 
TextQuestion ques_1234566551 Name null TargetAndBaseline 8 true true true true true true true true true true 0.5 0.2 Identity 9 Income 9  12/7/17    This is the nineth question 
TextQuestion ques_1234566552 Name null TargetAndBaseline 9 true true true true true true true true true true 0.5 0.2 Identity 10 Income 10  12/8/17  Page2 This is the tenth question 
TextQuestion ques_1234566553 Name null TargetAndBaseline 10 true true true true true true true true true true 0.5 0.2 Identity 11 Income 11  12/9/17    This is the eleventh question 

예 넣어 : 사전에

Customer: ParkerInc  Current as of: 11/30/17 11:24   

Page Question Text Question Type Question ID  Topic 1 Topic 2 Notes on Question   Date Added 
     Name   TextQuestion ques_1234566576 Identity Income This is the first question 1/1/18 
     Name   TextQuestion ques_1234566576 Identity Income This is the second question 1/1/18 

감사합니다.

Answer 1

컬렉션의 모든 개체에 대해 동일한 정보를 가져 오는 이유는 컬렉션에 여러 참조가있는 개체가 하나뿐이기 때문입니다. 컬렉션 또는 배열에 객체를 저장할 때 실제로 객체를 저장하는 것이 아니라 객체 인스턴스의 메모리 위치에 대한 참조 만 저장합니다.

반복 할 때마다 새 Object를 인스턴스화 한 다음 새 Object에 대한 참조를 Collection에 추가해야합니다.

Do 
    If IsEmpty(ActiveCell) Then 
     Exit Do 
    Else 
     Set questions = New Collection 

Answer 2

리팩토링 코드를 사용하여 배열 :

Sub createFormFields() 

    'Declare Variables 
    Dim Questions() As Variant 
    Dim LastRow As Long 
    Dim QuestionIndex As Long 
    Dim i As Long 
    Dim customer As String, newFileName As String, fileVersion As String 
    Dim fileExtension As String, filePath As String, formFieldsFile As String 
    Dim formFieldsFilepath As String, currentAsTime As String 
    Dim formFieldsWorkbook As Workbook, formFieldsSheet As Worksheet 

    With ActiveWorkbook.ActiveSheet 
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
     ReDim Questions(1 To LastRow - 26, 1 To 7) 
     For i = 27 To LastRow 
      QuestionIndex = QuestionIndex + 1 
      Questions(QuestionIndex, 1) = .Cells(i, "C").Value 'Question Text 
      Questions(QuestionIndex, 2) = .Cells(i, "A").Value 'Question Type 
      Questions(QuestionIndex, 3) = .Cells(i, "B").Value 'Question ID 
      Questions(QuestionIndex, 4) = .Cells(i, "S").Value 'Topic 1 
      Questions(QuestionIndex, 5) = .Cells(i, "U").Value 'Topic 2 
      Questions(QuestionIndex, 6) = .Cells(i, "Z").Value 'Notes 
      Questions(QuestionIndex, 7) = .Cells(i, "X").Value 'Date Added 
     Next i 
    End With 

    ' Save Pertenate Data for new Form Fields File from YAML_Script_Creator file 
    customer = Range("B3").Value 
    newFileName = Range("F18").Value 
    fileVersion = Range("F19").Value 
    fileExtension = Range("F20").Value 
    If Left(fileExtension, 1) <> "." Then fileExtension = "." & fileExtension 
    filePath = Range("F21").Value 
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\" 
    formFieldsFile = customer & newFileName & fileVersion & fileExtension 
    formFieldsFilepath = filePath & formFieldsFile 
    Debug.Print formFieldsFilepath 

    ' If file already exists, delete it 
    If Dir(formFieldsFilepath) <> "" Then 
     Kill (formFieldsFilepath) 
    End If 

    ' Create new form fields file 
    Set formFieldsWorkbook = Workbooks.Add 

    ' Set Active Sheet 
    Set formFieldsSheet = formFieldsWorkbook.ActiveSheet 

    ' Get current time and format it 
    currentAsTime = Format(Now(), "yyyy-MM-dd hh:mm:ss") 

    ' Format new sheet 
    formFieldsSheet.Range("A1") = "Customer:" 
    formFieldsSheet.Range("B1") = customer 
    formFieldsSheet.Range("D1") = "Current as of:" 
    formFieldsSheet.Range("E1") = currentAsTime 

    formFieldsSheet.Range("A3:H3") = Array("Page", "Question Text", "Question Type", "Question ID", "Topic 1", "Topic 2", "Notes on Question", "Date Added") 

    ' Make Font Bold 
    formFieldsSheet.Range("A1,D1,A3:H3").Font.Bold = True 

    ' Make Bottom Border Thick 
    formFieldsSheet.Range("A3:H3").Borders(xlEdgeBottom).Weight = xlThick 

    ' Set Cell Alignments 
    formFieldsSheet.Range("D1").HorizontalAlignment = xlRight 

    ' Set Column Widths 
    formFieldsSheet.Range("A1").ColumnWidth = 15.83 
    formFieldsSheet.Range("B1").ColumnWidth = 36.67 
    formFieldsSheet.Range("C1").ColumnWidth = 24.17 
    formFieldsSheet.Range("D1").ColumnWidth = 25 
    formFieldsSheet.Range("E1").ColumnWidth = 20 
    formFieldsSheet.Range("F1").ColumnWidth = 20 
    formFieldsSheet.Range("G1").ColumnWidth = 49.17 
    formFieldsSheet.Range("H1").ColumnWidth = 15.83 

    ' Activate cell to being writing data to 
    formFieldsSheet.Range("A4").Resize(UBound(Questions, 1), UBound(Questions, 2)).Value = Questions 

    formFieldsWorkbook.SaveAs Filename:=formFieldsFilepath 
    formFieldsWorkbook.Close 

End Sub