인접한 워크 시트의 셀을 찾아 현재 워크 시트에 복사

Question

인접한 워크 시트의 셀을 특정 기준을 충족하는 경우 현재 워크 시트에 복사하려면 매크로 (또는 함수)를 만들어야합니다.

다음은 소유자, 티켓 및 설명 필드가있는 현재 워크 시트 옆의 워크 시트입니다. 해당 필드를 현재 워크 시트의 해당 응용 프로그램 이름과 개체 (고유 ID로 연결됨)에 복사해야합니다.

다음은 내가 위의 필드에 복사해야 현재 워크 시트입니다. 응용 프로그램이 같은 순서로 나열되지 않습니다. 어떤 순서의 데이터인지, 동일한 데이터가 새 워크 시트에 포함될 지 모르는 경우에도 마찬가지입니다.

은 지금까지 나는이 기능을 시도했다 :

= IF (간접적 (NextSheetName() &) & 간접 (NextSheetName() & "B3!") = A3 & "A3!" B3, INDIRECT (NextSheetName() & "! D3"), "0")

워크 시트가 동일한 순서로 동일한 데이터를 갖는 경우에만 작동합니다.

누구에게 어떻게 할 수 있습니까?

Answer 1

VBA를 사용하여이 작업을 수행하려면 다음을 수행하십시오. 이 코드는 소스 워크 시트의 일치하는 행을 대상 워크 시트에 복사하고, 소스 워크 시트와 일치하는 행을 대상에 기록하여 유용 할 경우에 대비합니다. 나는 "Source"와 "Target"이라는 시트의 이름을 지정하고 A와 B 열의 연결을 일치 시키려고한다고 가정합니다.

원본 및 대상의 행 수는 중요하지 않으며 경기가 나타나는 순서.

나는 두 가지 버전을 썼다. 첫 번째는 효과가 있지만 대상에있는 각 값의 일치를 찾는 소스 범위를 반복하기 때문에 나는 그것에 미치지 않습니다. 두 번째 버전은 한 번 작성된 사전을 사용합니다. 일치하는 검색 용어는 범위를 반복하지 않고 수행됩니다. 사전을 사용하려면 Microsoft Scripting Runtime에 대한 참조가 필요합니다.

첫 번째 버전 (기능 만 필요로 여러 루프)

Sub GetTwoColumnMatches() 

    Dim wsrc As Worksheet 
    Dim wTgt As Worksheet 
    Dim rng As Range 
    Dim cell As Range 
    Dim lLastTargetRow As Long 
    Dim lMatchedRow As Long 
    Dim sConcat As String 

    Set wsrc = Sheets("Source") 
    Set wTgt = Sheets("Target") 
    lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row 


    Set rng = wTgt.Range("a2:a" & lLastTargetRow) 
    For Each cell In rng 
     sConcat = cell & cell.Offset(, 1) 
     lMatchedRow = Matches(sConcat) 
     If lMatchedRow <> 0 Then 
      wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _ 
      wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value 
      wTgt.Range("f" & cell.Row) = lMatchedRow 
     End If 
    Next 
End Sub 

Function Matches(SearchFor As String) As Long 
    Dim wsrc As Worksheet 
    Dim rng As Range 
    Dim cell As Range 
    Dim lLastSourceRow As Long 
    Dim lSourceRow As Long 

    Set wsrc = Sheets("Source") 
    lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row 

    Set rng = wsrc.Range("a2:a" & lLastSourceRow) 
    Matches = 0 
    For Each cell In rng 
     If cell & cell.Offset(, 1) = SearchFor Then 
      Matches = cell.Row 
      Exit For 
     End If 
    Next 
End Function 

두 번째 버전 : 여기

Sub GetTwoColumnMatches() 

    Dim wsrc As Worksheet 
    Dim wTgt As Worksheet 
    Dim rng As Range 
    Dim cell As Range 
    Dim srcRng As Range 
    Dim srcCell As Range 

    Dim lLastTargetRow As Long 
    Dim lLastSourceRow As Long 
    Dim lMatchedRow As Long 
    Dim lSourceRow As Long 

    Dim sConcat As String 
    Dim dict As Dictionary 

    Set wsrc = Sheets("Source") 
    Set wTgt = Sheets("Target") 
    lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row 

    Set wsrc = Sheets("Source") 
    lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row 

    'Create the dictionary 
    Set dict = New Dictionary 

    Set srcRng = wsrc.Range("a2:b" & lLastSourceRow) 
    For Each srcCell In srcRng 
     sConcat = srcCell & srcCell.Offset(, 1) 
     If Len(sConcat) > 0 Then dict.Add sConcat, srcCell.Row 
    Next 

    Set rng = wTgt.Range("a2:a" & lLastTargetRow) 
    For Each cell In rng 
     sConcat = cell & cell.Offset(, 1) 
     lMatchedRow = dict.Item(sConcat) 
     If lMatchedRow <> 0 Then 
      wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _ 
      wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value 
      wTgt.Range("f" & cell.Row) = lMatchedRow 
     End If 
    Next 
End Sub 

무엇 당신의 참조입니다 (최적화 된 마이크로 소프트 런타임 스크립팅을 참조 필요) Microsoft Scripting Runtime을 올바르게 선택한 경우처럼 보입니다.