반환 VBA의 다른 열에 해당하는 고유 값

Question

나는 VBA에 비교적 익숙하지 않으며이 문제를 해결하기위한 도움을 주시면 대단히 감사하겠습니다!

Excel에서 두 열의 텍스트 값을보고 두 열에 대해 고유 한 값만 반환하도록합니다. 그러나 두 열을 서로 "대응"시켜서 첫 번째 열의 고유 값이 반환되고 그 열의 고유 값 각각에 해당하는 고유 값이 옆에 반환됩니다.

e.e. 열이 다음과 같은 경우 :

Column 1: a a a d d g g g g 

그리고 두 번째 열의 값이

Column 2: 3 3 2 1 1 7 8 8 9 

은 내가 처음 여기에 열 1.보고 싶은이며, 최초의 고유 한 값은이다. 그런 다음 2 열 (예 : 3 및 2)의 모든 고유 값을 가져옵니다. 따라서 (1,1) = a, (1,2) = 3, (2,2) = 2 및 (2,1) = 비어 있음. 다음은 아래의 고유 값이므로 (3,1) = d, (3,2) = 2, (4,1) = 비어있는 (4,2) = 1입니다. 그러면 (5,1) = g, (5,2) = 7, (6,1) = 공백, (6,2) = 8, (7,1) = 공백, (7,2) = 9 .

설명하는 것이 약간 까다 롭지 만, 요점을 얻는 것이 여전히 가능하기를 바랍니다.

감사합니다.

Answer 1

이 코드는

Option Explicit 

Sub Main() 

    Dim r1 As Range 
    Set r1 = Application.InputBox(prompt:="Select first range", Type:=8) 

    Dim r2 As Range 
    Set r2 = Application.InputBox(prompt:="Select second range", Type:=8) 

    If r1.Rows.Count <> r2.Rows.Count Then 
     MsgBox "ranges aren't equal in rows, restart the macro!", vbCritical 
     Exit Sub 
    End If 

    ReDim arr(0) As String 
    Dim i As Long 
    For i = 1 To r1.Rows.Count 
     arr(UBound(arr)) = r1.Rows(i) & "###" & r2.Rows(i) 
     ReDim Preserve arr(UBound(arr) + 1) 
    Next i 
    RemoveDuplicate arr 
    ReDim Preserve arr(UBound(arr) - 1) 

    With Sheets(2) 
     .Activate 
     .Columns("A:B").ClearContents 

     For i = LBound(arr) To UBound(arr) 
      .Range("A" & i + 1) = Split(arr(i), "###")(0) 
      .Range("B" & i + 1) = Split(arr(i), "###")(1) 
     Next i 

     For i = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1 
      If StrComp(.Range("A" & i).Offset(-1, 0), .Range("A" & i), vbTextCompare) = 0 Then 
       .Range("A" & i) = vbNullString 
      End If 
     Next i 
    End With 

End Sub 


Sub RemoveDuplicate(ByRef StringArray() As String) 
    Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String 
    If (Not StringArray) = True Then Exit Sub 
    lowBound = LBound(StringArray): UpBound = UBound(StringArray) 
    ReDim tempArray(lowBound To UpBound) 
    cur = lowBound: tempArray(cur) = StringArray(lowBound) 
    For A = lowBound + 1 To UpBound 
     For B = lowBound To cur 
      If LenB(tempArray(B)) = LenB(StringArray(A)) Then 
       If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For 
      End If 
     Next B 
     If B > cur Then cur = B 
    tempArray(cur) = StringArray(A) 
    Next A 
    ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray 
End Sub 

---

어떤 일이 것은 당신이 당신의 마우스로 각 열을 선택하라는 메시지가 있음을 다할 것입니다. 따라서 스프레드 시트가 어떻게 든 아래의 그림처럼 보이면 원하는 두 개의 열을 선택하십시오. 첫 번째 열에는 두 번째 열에 대한 질문이 표시됩니다. (은 뭐죠 빨간색에서 선택) 두 번째 열의

를 반복하고 결과는 Sheet2