VBA에서 하나의 vlookup을 사용하여 여러 결과를 얻는 방법 여기서 vlookup은 전체 문자열 (vlookup 값)의 일부입니다

Question

3 개의 시트가 있습니다. 시트 하나에 "Register Codes"열이 있고 고유 코드가 추출되었습니다. 다음 열에 아래 이미지를 확인하십시오. 이러한 고유 코드를 기반으로

은

, 서브 코드는 아래 이미지를 확인하시기 바랍니다 시트 2에 할당됩니다.

지금 내가 여기에 시도하고 시트 3에서 나는 모든 가 "독특한에 따라 시트 2에 할당 관련 "하위 코드 "로"코드 등록 "을해야한다는 것입니다 ID "은 Sheet1에 지정되어 있습니다. 아래 이미지에서 예상 출력을 확인하십시오.

나는 식의 다양한 조합을 사용하고 있지만, 적절한 해결책을 가져올 수 없습니다. VBA에서이 분야에서 배우기 시작한 가장 좋은 방법은 무엇입니까?

Answer 1

몇 가지 조건에 따라 다음 코드는 원하는 것을 수행합니다. 데이터가있는 통합 문서에서 표준 코드 모듈 (기본적으로 "Module1"이지만 원하는대로 이름을 지정할 수 있음)에 설치하십시오.

Option Explicit 

Enum Nws          ' Worksheet navigation 
    NwsFirstDataRow = 2       ' presumed the same for all worksheets 
    NwsCode = 1         ' 1 = column A (change as required) 
    NwsSubCode         ' No value means previous + 1 
    NwsNumer 
End Enum 

Sub NumerList() 
    ' 05 Apr 2017 

    Dim Wb As Workbook       ' all sheets are in the same workbook 
    Dim WsCodes As Worksheet     ' Register codes 
    Dim WsNum As Worksheet      ' Sub-code values 
    Dim WsOut As Worksheet      ' Output worksheet 
    Dim RegName As String, RegCode As String 
    Dim Sp() As String 
    Dim Rs As Long        ' Source row in WsNum 
    Dim Rt As Long        ' Target row in WsOut 
    Dim R As Long, Rl As Long     ' rows/Last row in WsCodes 

    Set Wb = ActiveWorkbook      ' Make sure it is active! 
    Set WsCodes = Wb.Worksheets("Reg Codes") ' Change name to your liking 
    Set WsNum = Wb.Worksheets("Code Values") ' Change name to your liking 

    On Error Resume Next 
    Set WsOut = Wb.Worksheets("Output")   ' Change name to your liking 
    If Err Then 
     Set WsOut = Wb.Worksheets.Add(After:=WsNum) 
     WsOut.Name = "Output"     ' create the worksheet if it doesn't exist 
    End If 
    On Error GoTo 0 

    Rt = NwsFirstDataRow 
    With WsCodes 
     Rl = .Cells(.Rows.Count, NwsCode).End(xlUp).Row 
     For R = NwsFirstDataRow To Rl 
      RegName = .Cells(R, NwsCode).Value 
      Sp = Split(RegName, "-") 
      If UBound(Sp) > 1 Then    ' must find at least 2 dashes 
       RegCode = Trim(Sp(1)) 
      Else 
       RegCode = "" 
      End If 

      If Len(RegCode) Then 
       On Error Resume Next 
       Rs = WorksheetFunction.Match(RegCode, WsNum.Columns(NwsCode), 0) 
       If Err Then Rs = 0 
       On Error GoTo 0 

       If Rs Then 
        Do 
         WsOut.Cells(Rt, NwsCode).Value = RegName 
         WsOut.Cells(Rt, NwsSubCode).Value = WsNum.Cells(Rs, NwsSubCode).Value 
         WsOut.Cells(Rt, NwsNumer).Value = WsNum.Cells(Rs, NwsNumer).Value 
         Rt = Rt + 1 
         Rs = Rs + 1 
        Loop While WsNum.Cells(Rs, NwsCode).Value = RegCode 
       Else 
        RegCode = "" 
       End If 
      End If 

      If Len(RegCode) = 0 Then 
       WsOut.Cells(Rt, NwsCode).Value = RegName 
       WsOut.Cells(Rt, NwsSubCode).Value = "No sub-code found" 
       Rt = Rt + 1 
      End If 
     Next R 
    End With 
End Sub 

그리고 여기 조건이 있습니다.

1. 3 장 모두 같은 통합 문서에 있어야합니다. 서로 다른 통합 문서를 사용하는 경우 두 개 이상의 통합 문서를 처리 할 수있는 코드를 사용해야합니다.
2. 데이터가있는 두 개의 워크 시트가 있어야합니다. 코드 명칭과 일치하도록 이름을 지정하거나 코드를 수정해야합니다. 출력 워크 시트도 동일하지만 코드가 존재하지 않으면 해당 시트가 작성됩니다. 코드에서 이름을 변경할 수 있습니다.
3. 코드 상단의 열거는 모든 3 개의 시트가 행 1 (자막)의 데이터가없고 A, B 및 C 열의 데이터와 동일하게 포맷되어 있다고 가정합니다. 변경은 어렵지 않지만 원하는 경우 만들어야합니다 다른 입력 또는 출력. 열거 형의 열에 다른 값을 할당하여 기존 코드의 열을 변경할 수 있지만 코드에는 모든 시트에서 동일한 배열이 필요합니다.
4. 코드 시트에서 추출 된 코드는 사용되지 않습니다. 코드는 자체 추출을 수행합니다. 코드를 추출 할 수 없거나 서브 코드 목록에서 코드를 찾을 수없는 경우 출력 목록에 오류가 표시됩니다.
5. 숫자 시트의 하위 코드는 게시 한 그림과 같이 정렬되어야합니다. 코드는 "image"의 첫 번째 항목을 찾고 코드가 A 열의 코드 인 동안 다음 행의 하위 코드를 찾습니다. 중단 후에 나타날 수있는 "이미지"의 추가 항목을 찾지 않습니다.
6. 코드는 색칠을하지 않습니다. 추가는 어렵지 않지만 처음 20 개의 코드에 대해 20 가지 색상을 지정하고 동일한 순서를 반복하는 것과 같은 몇 가지 규칙을 지정해야합니다.
7. 각 셀에 이미 개별적으로 이름이 지정 되었기 때문에 다른 셀 서식을 추가 할 수있었습니다. 더 많은 속성을 쉽게 추가 할 수 있습니다.