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