找到所有可能的字符串对 - VBA

时间:2016-11-07 20:11:14

标签: vba

在A栏中,我有一个字符串列表。在下一篇专栏文章中,我想拥有所有可能的对(连接),例如:

| A列| B栏|

| A | | AB |

| B | | AC |

| C | | BC |

| ... | | ... |

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

1 个答案:

答案 0 :(得分: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