2016-11-07 4 views
-1

列Aには、文字列のリストがあります。次の列では、すべての可能なペア(連結)を持っていたいと思います。文字列の可能なすべてのペアを見つける - VBA

| Column A | | B列|

| A | | AB |

| B | | AC |

| C | | BC |

| ... | | ... |

私は列Aに150を超える文字列を持っています。私は二重ループが必要だと思っていますが、どのように進むべきかはわかりません。

+0

あなたはこれまでに何を試しましたか?すべてのセルをループしてから、内部ループもすべてのセルをループし、結果を列Bに連結します。 –

答えて

0

ここに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 
関連する問題