Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/16.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
查找所有可能的字符串对-VBA_Vba - Fatal编程技术网

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

查找所有可能的字符串对-VBA,vba,Vba,在A列中,我有一个字符串列表。在下一篇专栏文章中,我希望有所有可能的对(串联),例如: |A列| B列| |A | | AB| |B | | AC| |西元前| |…| || 我的A列中有150多个字符串。我想我需要一个双循环,但我不确定如何继续 这里有一种方法 Option Explicit ' Modify if you want to delimit the concatenated values Const delimiter As String = vbNullString ' If

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

|A列| B列|

|A | | AB|

|B | | AC|

|西元前|

|…| ||

我的A列中有150多个字符串。我想我需要一个双循环,但我不确定如何继续

这里有一种方法

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
选项显式
'如果要分隔连接的值,请进行修改
常量分隔符为String=vbNullString
'如果要将单元格与其自身连接,请将其设置为True
Const compareSelf为Boolean=False
子对_mem()
'pairs过程调用ConcatValues将数据写入工作表
'此过程创建每个单元格的成对组合
'这不会忽略重复项(项目或对)或任何其他特殊注意事项
变暗rng As范围
调暗cl1作为范围,cl2作为范围,目的地作为范围
暗我一样长,长一样长
'要连接的值的范围,根据需要修改
设置rng=范围(“A1:A7”)
长度=rng.Cells.Count
'开始将输出放入B1,根据需要进行修改
设置目的地=范围(“B1”)
'获取输出数组的大小
'output()是输出值的数组容器
如果比较一下你自己
重拨输出(1到长度*(长度-1))
其他的
重拨输出(1到长度^2)
如果结束
i=1
对于rng.单元格中的每个cl1
对于rng.单元格中的每个cl2
如果cl1.Address=cl2.Address,则
如果比较一下你自己
输出(i)=浓度值(cl1、cl2)
i=i+1
如果结束
其他的
输出(i)=浓度值(cl1、cl2)
i=i+1
如果结束
下一个
下一个
dest.Resize(UBound(output)).Value=Application.Transpose(output)
端接头
函数ConcatValues(ParamArray vals()作为变量)
'调用此函数进行连接,并将“i”值返回给调用者
暗淡的$
暗itm
每个itm的VAL
s=s&itm&分隔符
下一个
如果分隔符为vbNullString,则
s=左(s,透镜-1)
如果结束
ConcatValues=s
端函数

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