人们进行调查，他们的回答在Excel电子表格中排成一行。人们进行多次调查，因此他们的反应遍布多个工作表。这些人在每次调查之前都会使用他们的身份证。
我想循环遍历每个工作表中的行，并使用特定人员的调查回复从行中复制选择单元格。假设是将响应一起拉到一个电子表格中的人知道ID。
到目前为止我所拥有的是：
Sub CreateSPSSFeed()
Dim StudentID As String ' (StudentID is a unique identifier)
Dim Tool As Worksheet ' (this is the worksheet I'm pulling data into)
Dim Survey1 As Worksheet ' (this is the sheet I'm pulling data from)
Dim i As Integer ' (loop counter)
Tool = ActiveWorkbook.Sheets("ToolSheet")
Survey1 = ActiveWorkbook.Sheets("Survey1Sheet")
' (This is how the loop knows what to look for)
StudentID = Worksheet("ToolSheet").Range("A2").Value
ActiveWorksheet("Survey1").Select ' (This loop start with the Survey1 sheet)
For i = 1 to Rows.Count ' (Got an overflow error here)
If Cells (i, 1).Value = StudentID Then
'!Unsure what to do here-- need the rest of the row
' with the matching StudentID copied and pasted
' to a specific row in ToolSheet, let's say starting at G7!
End If
Next i
End Sub
我绝对不打算让任何人为我做这项工作。我已经尝试过在这里研究概念和语言，并且没有很多运气将循环与移动表格相结合。
答案 0 :(得分：0)
试试这个：
Sub CreateSPSSFeed()
Dim StudentID As String '(StudentID is a unique identifier)
Dim rng as Range
StudentID = Worksheet("ToolSheet").Range("A2").Value 'if you get error try to add Set = StudentID.....
j = 7
for x = 2 to sheets.count
For i = 1 to Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row 'last not empty row
If sheets(x).Cells (i, 1).Value = StudentID Then
sheets(x).range(cells(i, 2),cells(i, 6)).copy _'adapt range to your needs
Destination:=activesheet.Cells(j, 7) 'this is G7
j = j + 1
End If
Next i
next x
End Sub
仅从将数据汇集到“工具”的工作表中运行此代码。 现在，您已在循环中为工作表嵌套循环。 PS：无需复制整行，只需复制值范围，以避免错误。
答案 1 :(得分：0)
这个不好，但可能会让你前进：
Sub CreateSPSSFeed()
Dim StudentID As String '(StudentID is a unique identifier)
Dim Tool As Worksheet '(this is the worksheet I'm pulling data into)
Dim Survey1 As Worksheet '(this is the sheet I'm pulling data from)
'Dim i As Integer '(loop counter) 'You don't need to define it
Set Tool = ActiveWorkbook.Worksheets("ToolSheet") 'you'll need to use the Set command, don't ask why
Set Survey1 = ActiveWorkbook.Worksheets("Survey1Sheet")
ToolLastRow = Tool.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'so you won't need to loop through a million rows each time
Survey1LastRow = Survey1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Survey1LastColumn = Survey1.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For j = 2 To ToolLastRow 'For each student ID from A2 down on toolsheet
StudentID = Tool.Cells(j, 1).Value2 '(This is how the loop knows what to look for) 'why define it if you don't use it
'ActiveWorksheet("Survey1").Select '(This loop start with the Survey1 sheet) 'Activeworksheet -> Activeworkbook but unnecessary,see below
For i = 1 To Survey1LastRow '(Got an overflow error here) 'you won't get an overflow error anymore
If Cells(i, 1).Value2 = StudentID Then
'!Unsure what to do here--need the rest of the row with the matching StudentID copied and pasted to a specific row in ToolSheet, let's say starting at G7!
'let's put the data starting at survey1's B# to the cells starting at tool's G#
For k = 2 To Survey1LastColumn '2 refers to B, note the difference between B=2 and G=7 is 5
Tool.Cells(j, k + 5) = Survey1.Cells(i, k)
Next k
End If
Next i
Next j
End Sub
答案 2 :(得分：0)
这将检查以＆＃39; Survey＆＃39;开头的工作簿中的所有工作表中的行1：500（可以轻松更改为整列或不同范围）并粘贴到工具表。 确保工具表上的学生ID之间有足够的空间来粘贴所有可能的事件。
FIND方法来自：https://msdn.microsoft.com/en-us/library/office/ff839746.aspx
Sub CreateSPSSFeed()
Dim sStudentID As String
Dim shtTool As Worksheet
Dim rFoundCell As Range
Dim sFirstFound As String
Dim rPlacementCell As Range
Dim lCountInToolSheet As Long
Dim wrkSht As Worksheet
'Set references.
With ActiveWorkbook
Set shtTool = .Worksheets("ToolSheet")
sStudentID = .Worksheets("ToolSheet").Cells(2, 1).Value
End With
'Find where the required student id is in the tool sheet.
With shtTool.Range("A:A")
'Will start looking after second row (as this contains the number you're looking for).
Set rPlacementCell = .Find(sStudentID, After:=.Cells(3), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'If the Student ID doesn't appear in column A it
'will find it in cell A2 which we don't want.
If rPlacementCell.Address = .Cells(2).Address Then
'Find the last row on the sheet containing data -
'two rows below this will be the first occurence of our new Student ID.
lCountInToolSheet = .Find("*", After:=.Cells(1), SearchDirection:=xlPrevious).Row + 2
'An existing instance of the number was found, so count how many times it appears (-1 for the instance in A2)
Else
lCountInToolSheet = WorksheetFunction.CountIf(shtTool.Range("A:A"), sStudentID) - 1
End If
'This is where our data will be placed.
Set rPlacementCell = rPlacementCell.Offset(lCountInToolSheet)
End With
'Look at each sheet in the workbook.
For Each wrkSht In ActiveWorkbook.Worksheets
'Only process if the sheet name starts with 'Survey'
If Left(wrkSht.Name, 6) = "Survey" Then
'Find each occurrence of student ID in the survey sheet and paste to the next available row
'in the Tool sheet.
With wrkSht.Range("A1:A500")
Set rFoundCell = .Find(sStudentID, LookIn:=xlValues, LookAt:=xlWhole)
If Not rFoundCell Is Nothing Then
sFirstFound = rFoundCell.Address
Do
'Copy the whole row - this could be updated to look for the last column containing data.
rFoundCell.EntireRow.Copy Destination:=rPlacementCell
Set rPlacementCell = rPlacementCell.Offset(1)
Set rFoundCell = .FindNext(rFoundCell)
Loop While Not rFoundCell Is Nothing And rFoundCell.Address <> sFirstFound
End If
End With
Set rFoundCell = Nothing
End If
Next wrkSht
End Sub
编辑：我已经添加了更多评论和额外代码，因为第一部分总是会找到放置在单元格A2中的学生ID。