2016-11-07 84 views
-1

在列A中,我有一个字符串列表。在下一列中,我想要有所有可能的对(连接),例如:查找所有可能的字符串对 - VBA

|列A | B列|

| A | | AB |

| B | | AC |

| C | | BC |

| ... | | ... |

我在我的列A中有超过150个字符串。我想我需要一个双循环,但我不知道如何继续。

+0

到目前为止您尝试了什么?循环遍历每个单元格,然后您的内部循环将循环遍历每个单元格,并将结果连接到列B。 –

回答

0

下面是一种方法。

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 
相关问题