Прокрутите лист, найдите определенное значение, вставьте строку с соответствующим значением в другой лист

Question

Люди берут опрос, и их ответы заканчиваются в одной строке в электронной таблице Excel. Люди проводят несколько опросов, поэтому их ответы распространяются на нескольких листах. У этих людей есть идентификаторы, которые они используют перед каждым опросом.

Я хочу прокручивать строки на каждом листе и копировать выделенные ячейки из строки с ответами конкретного человека. Предположение заключается в том, что человек, вытягивающий ответы вместе, в одну таблицу знает идентификатор.

То, что я до сих пор это:

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 

Я определенно не собираюсь для тех, кто, чтобы сделать работу для меня. Я пробовал исследовать понятия и язык здесь и не имел большого количества удачи, комбинируя петли с перемещением по листам.

Answer 1

Попробуйте это:

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 

Выполнить этот код только из листа, где вы Объединив данные в "Tool". Теперь у вас есть вложенный цикл для строк в цикле для листов. PS: нет необходимости копировать целую строку, просто диапазон со значением, чтобы избежать ошибок.

Answer 2

Это один не очень хорошо, но может получить ты:

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 

Answer 3

Это будет проверять строки 1: 500 (можно легко изменить на весь столбец или другой диапазон) во всех листов в книге, которая начинается с ' Обследование "и вставить в лист инструмента. Убедитесь, что у вас достаточно места между идентификаторами ученика на листе инструментов, чтобы вставить все возможные вхождения.

Метод 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 

Edit: я добавил еще комментарии и дополнительный код, реализованного в первом разделе будет всегда найти Student ID, который помещается в ячейку A2.