我写了以下宏。
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
宏在一个Excel工作表中遍历行，将该行中每列的数据保存到我为其编写类的对象中，将每个对象添加到集合中，然后将数据写入新的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
提前致谢。
答案 0 :(得分：0)
为集合中的每个对象获取相同信息的原因是集合中只有一个对象具有多个引用。当您在集合或数组中存储对象时，实际上并不存储对象只是对对象实例的内存位置的引用。
您需要做的是在每次迭代期间实例化一个新对象，然后将对新对象的引用添加到Collection。
Do
If IsEmpty(ActiveCell) Then
Exit Do
Else
Set questions = New Collection
答案 1 :(得分：0)
使用数组重构代码：
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