Excel 在工作表中循环，查找特定值，将具有匹配值的行粘贴到另一个工作表

人们进行调查后，他们的回答会在Excel电子表格中显示为一行。人们进行了多次调查，因此他们的回答分布在多张工作表中。这些人在每次调查前都有身份证

我想在每个工作表中的行中循环，并从带有特定人员调查响应的行中复制某些单元格。假设将响应拉入一个电子表格的人知道ID

子创建SPSSFeed Dim StudentID作为字符串'StudentID是唯一标识符 Dim Tool As Worksheet'这是我将数据拉入的工作表 Dim Survey1作为工作表“这是我从中提取数据的工作表 Dim i作为“整数”循环计数器 工具=活动工作簿。工作表工作表 Survey1=ActiveWorkbook.SheetsSurvey1工作表 “这就是循环知道要寻找什么的方式 StudentID=工作表ToolSheet.RangeA2.Value 活动工作表1。选择“此循环从测量表1开始” 对于i=1到Rows.Count，此处出现溢出错误 如果单元格i，1.Value=StudentID，则 '!不确定在这里做什么-需要行的其余部分吗 '复制并粘贴匹配的StudentID '到工具表中的特定行，假设从G7开始！ 如果结束 接下来我 端接头 我在这里进行了研究，并没有很好地将循环与在图纸上移动相结合。

试试这个：

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

仅从将数据汇集到工具中的工作表运行此代码。 现在，在图纸的循环中有了行的嵌套循环。

---

注：无需复制整行，只需使用值范围，以避免错误。

这一行不好，但可能会让您继续：

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

---

这将检查行1:500是否可以轻松更改为工作簿中以“测量”开头的所有工作表中的整列或不同范围，并粘贴到工具工作表中。 确保工具表上的学生id之间有足够的空间来粘贴所有可能出现的情况

查找方法来自以下位置：

---

编辑：我添加了更多注释和额外代码，因为我意识到第一部分总是会找到放在单元格A2中的学生ID。

您指的是溢出吗？如果是这样，请知道我正在处理的行数不会超过几百行。@pnuts是正确的。使用long。2003年的行数约为65000行，2007年及以后约为100万行。即使你没有走那么远，编译器在实际运行程序之前已经在检查你的变量是否可以处理它。这看起来绝对是朝着正确的方向迈出的一步！今天晚些时候我会试试这个，如果它有一部分起作用的话，我一定会给你信用。谢谢看看你的评论：斜体！不确定要在这里做什么，需要将行的其余部分以及匹配的StudentID复制并粘贴到ToolSheet中的特定行，比如说从G7开始_斜体\如果复制整行，则必须将其粘贴到A列-如果将其粘贴到G列，则会尝试将16384列粘贴到16377个可用列中，并且会出现错误复制粘贴区域的大小或形状不同。

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