가능한 모든 쌍의 문자열 찾기 - VBA

Question

열 A에는 문자열 목록이 있습니다. 다음 열에서는 가능한 모든 쌍 (연결됨)을 갖고 싶습니다.

| Column A | 열 B |

| A | | AB |

| B | | 교류 |

| C | | BC |

| ... | | ... |

나는 내 열 A에 150 개가 넘는 문자열을 가지고 있습니다. 이중 루프가 필요 하겠지만 진행 방법을 잘 모르겠습니다.

Answer 1

하나의 방법이 있습니다.

Option Explicit 
' Modify if you want to delimit the concatenated values 
Const delimiter As String = vbNullString 
' If you want to concatenate a cell with itself, set this to True 
Const compareSelf As Boolean = False 

Sub pairs_mem() 
'The pairs procedure calls on ConcatValues to write out data to sheet 
' this procedures create pairwise combinations of each cell 
' this does not omit duplicates (items nor pairs) or any other special considerations 
Dim rng As Range 
Dim cl1 As Range, cl2 As Range, dest As Range 
Dim i As Long, length As Long 

'Range of values to be concatenated, Modify as needed 
Set rng = Range("A1:A7") 
length = rng.Cells.Count 
'Begin putting output in B1, Modify as needed 
Set dest = Range("B1") 
'Get the size of the output array 
' output() is array container for the output values 
If compareSelf Then 
    ReDim output(1 To length * (length - 1)) 
Else 
    ReDim output(1 To length^2) 
End If 

i = 1 
For Each cl1 In rng.Cells 
    For Each cl2 In rng.Cells 
     If cl1.Address = cl2.Address Then 
      If compareSelf Then 
       output(i) = ConcatValues(cl1, cl2) 
       i = i + 1 
      End If 
     Else 
      output(i) = ConcatValues(cl1, cl2) 
      i = i + 1 
     End If 
    Next 
Next 

dest.Resize(UBound(output)).Value = Application.Transpose(output) 

End Sub 
Function ConcatValues(ParamArray vals() As Variant) 
    'Call this function to do the concatenation and returns the "i" value to caller 
    Dim s$ 
    Dim itm 
    For Each itm In vals 
     s = s & itm & delimiter 
    Next 
    If delimiter <> vbNullString Then 
     s = Left(s, Len(s) - 1) 
    End If 
    ConcatValues = s 

End Function