셀 범위의 가능한 모든 값 찾기, 복사 및 붙여 넣기

Question

셀의 행 (행 요소가 다를 수 있음)과 여러 개의 데이터 열이있는 다른 시트가 있습니다. 시트 1에 데이터가있는 7 개의 열 (제목이있는 첫 번째 열)이 있고 시트 2에 첫 번째 행에이 제목 중 일부가 배치되어 있다고 가정 해 보겠습니다. 작업은 시트 2의 각 제목에 대해 가능한 모든 값을 찾는 것입니다. 첫 번째 셀의 시트 2에서 제목 X가 있다고 가정하면 시트 1의 제목 X에 해당하는 모든 값을 찾아서 그 결과를 가져와야합니다 시트 1의 8 번째 열. 그런 다음 2 번째 시트의 셀 2와 동일하게 행의 끝까지 계속됩니다.

누군가 나에게 도움이 될만한 힌트 나 제안을 공유 할 수 있습니까?

사실 나는 다음과 같은 코드를 사용 :.

시트 ("시트 2")를 건 내가 기능을 여러 번 반복하거나 많이하는 방법을 잘 모르겠어요이다

Dim Lcola As Long 
    Dim rng As Range 

    With ActiveSheet 
     Lcola = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     Set rng = .Range(.Cells(2, 1), .Cells(2, Lcola)) 
      With rng 
       Range("A2").Select 
       ActiveCell.Formula = "=VLOOKUP(A$1,MAP!$A$1:$I$" & lRowc & _ 
       ",8,FALSE)" 
       Selection.AutoFill Destination:=rng, Type:=xlFillDefault 
      End With 
    End With 

선택 반복에 내가 시트 1의 시트 2에서 각 변수에있는 것처럼. 그리고 내가 직면하고있는 또 다른 문제는 vlookup 함수가 항상 나를 찾은 첫 번째 항목을 제공한다는 것입니다.

Answer 1

For 루프를 사용하여 Sheet2의 마지막 열을 카운터 Max로 사용하십시오.

iCol을 사용하여 복사하고 읽는 Sheet2의 열을 추적합니다.
iRow를 사용하여 Sheet1에 원하는 데이터가있는 행을 추적합니다.

시트 1에 8 번째 열이 필요하다는 것을 알았으므로 시트 1 (Sheet1), 셀 (iRow 8) 이 항상 열 머리글이 Sheet2에 있음을 알고 있으므로, 시트 ("Sheet2"), 셀 (1, iCol) - 헤더 행이 1 인 경우

그런 다음 해당 Sheet2 열의 LastRow 검사를 한 번에 하나씩 추가하십시오.

Dim iCol As Integer 
Dim lastCol As Integer 
Dim lastRow1 As Integer 
Dim lastRow2 As Integer 
Dim matchRow As Integer 
Dim tempVal As String 
Dim iRow As Integer 
Dim nRow As Integer 

Private Sub IndexMatchLoop() 

lastCol = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column 

For iCol = 1 To lastCol 

    'Assuming your row on Sheet2 is 1. 
    tempVal = Sheets("Sheet2").Cells(1, iCol) 
    iRow = 1 

    Call GetLastRow 
    nRow = lastRow2 + 1 

    'Looks up the value from Sheet2 Column Header on Column1 of Sheet1 one Row at a Time 
    For iRow = 1 to lastRow1 
     If Sheets("Sheet1").Cells(iRow, 1) = tempVal Then 
    'Copy the data from Sheet1 Column 8 in the Rows with the value to Sheet2, the nextRow of the Col 
      Sheets("Sheet2").Cells(nRow, iCol) = Sheets("Sheet1").Cells(iRow, 8) 
      nRow = nRow + 1 
     End If 
    Next iRow 

Next iCol 

End Sub 

Private Sub GetLastRow() 
    lastRow1 = Sheets("Sheet1").Cells(65532, 1).End(xlUp).Row 
    lastRow2 = Sheets("Sheet2").Cells(65532, iCol).End(xlUp).Row 
End Sub 

편집 : 식 (대신 "정수"의 "지능"자동 완성에 의존했다 편집에 오타 : 추가 스크린 샷