烦请各位大师按照附件写个公式或者代码

飞越一切

烦请各位大师按照附件写个公式或者代码 3个数字的组合.rar (8.3 KB, 下载次数: 8)

2018-7-26 10:51 上传

点击文件名下载附件

zhjlgaojuan

Sub test()
Dim SourceArr, TargetArr, MyDic As Object, i%, j%, k%, s$, MyReg As Object
Set MyDic = CreateObject("scripting.dictionary")
Set MyReg = CreateObject("vbscript.regexp")
MyReg.Pattern = ",(\d+),.*\1"
MyReg.Global = True
SourceArr = Range("b2:b4")
For i = 1 To 3
    SourceArr(i, 1) = Split(SourceArr(i, 1), ",")
Next
For i = 0 To 3
    For j = 0 To 3
        For k = 0 To 3
            s = SourceArr(1, 1)(i) & "," & SourceArr(2, 1)(j) & "," & SourceArr(3, 1)(k)
            If MyReg.test("," & s & ",") = False Then MyDic(s) = ""
        Next
    Next
Next
TargetArr = MyDic.keys
[d2].Resize(UBound(TargetArr), 1) = WorksheetFunction.Transpose(TargetArr)
End Sub

飞越一切

zhjlgaojuan 发表于 2018-7-26 11:46
Sub test()
Dim SourceArr, TargetArr, MyDic As Object, i%, j%, k%, s$, MyReg As Object
Set MyDic =  ...

变动数字后，组合变成4个数的组合了

lsdongjh

1. Sub Test()
   
2.     Dim shSource As Worksheet
   
3.     Dim arrSource As Variant, lngRow As Long, lngCount As Long
   
4.     Dim strNum(1 To 3) As String, strTemp As String, strFind As String
   
5.     Dim strSplit_A() As String, strSplit_B() As String, strSplit_C() As String
   
6.     Dim strResult() As String
   
7.     Dim lngA As Long, lngB As Long, lngC As Long
   
8.    
   
9.     Set shSource = Sheets("Sheet3")
   
10.    
    
11.     arrSource = shSource.Range("B2:B4")
    
12.     lngCount = 1
    
13.     For lngRow = 1 To 3
    
14.         strTemp = arrSource(lngRow, 1)
    
15.         strTemp = Replace(strTemp, ",", Space(1))
    
16.         strTemp = Trim(strTemp)
    
17.         strNum(lngRow) = strTemp
    
18.         lngCount = lngCount * (UBound(Split(strTemp, Space(1))) + 1)
    
19.     Next
    
20.    
    
21. 
    
22.     ReDim strResult(1 To lngCount, 1 To 1) As String
    
23.     lngCount = 1
    
24.     strTemp = strNum(1)
    
25.     strSplit_A = Split(strTemp)
    
26.     For lngA = LBound(strSplit_A) To UBound(strSplit_A)
    
27.         strTemp = Space(1) & strNum(2) & Space(1)
    
28.         strFind = Space(1) & strSplit_A(lngA) & Space(1)
    
29.         strTemp = Replace(strTemp, strFind, Space(1))
    
30.         strTemp = Trim(strTemp)
    
31.         strSplit_B = Split(strTemp)
    
32.         For lngB = LBound(strSplit_B) To UBound(strSplit_B)
    
33.             strTemp = Space(1) & strNum(3) & Space(1)
    
34.             strFind = Space(1) & strSplit_A(lngA) & Space(1)
    
35.             strTemp = Replace(strTemp, strFind, Space(1))
    
36.             strFind = Space(1) & strSplit_B(lngB) & Space(1)
    
37.             strTemp = Replace(strTemp, strFind, Space(1))
    
38.             strTemp = Trim(strTemp)
    
39.             strSplit_C = Split(strTemp)
    
40.             For lngC = LBound(strSplit_C) To UBound(strSplit_C)
    
41.                 strTemp = strSplit_A(lngA) & "," & strSplit_B(lngB) & "," & strSplit_C(lngC)
    
42.                 strResult(lngCount, 1) = strTemp
    
43.                 lngCount = lngCount + 1
    
44.             Next
    
45.         Next
    
46.     Next
    
47.    
    
48.     shSource.Range("D2").Resize(UBound(strResult), 1) = strResult
    
49. End Sub

复制代码

zhjlgaojuan

飞越一切 发表于 2018-7-26 12:24
变动数字后，组合变成4个数的组合了

我不知道你是怎么变的,我测试过一点问题都没有的

zhjlgaojuan

s = SourceArr(1, 1)(i) & "," & SourceArr(2, 1)(j) & "," & SourceArr(3, 1)(k)
这一句只有3个数字组合在一起,怎么可能变成你说的4个数字呢?逗号变成句号?还是半角变成全角?