Sub Combine() Dim ws As Worksheet '定义一个Worksheet对象 Dim lastRow As Integer '定义一个整型变量，用来存放单元格最大已使用行号 Dim arr(), arrResult(), arrTem() As String, strRef As String, total As Integer Dim temp As String '将当前工作簿中名为 "Sheet1" 的工作表对象分配给变量 ws，以便在后续的代码中可以通过 ws 来引用这个工作表。 '或者说把ws这个工作表对象变量指向"Sheet1"工作表 '或者说给ws赋值，反正后面ws就代表Sheet1 Set ws = ThisWorkbook.Sheets("Sheet1") With ws '针对ws进行操作，在引用其属性、方法时，ws可以省略，直接以"."开始 '取得工作表最大已使用行号，存入变量lastRow lastRow = ws.UsedRange.Rows.Count '清除已有数据 .Range("O1").Resize(lastRow, 2).Clear '把M到N列，有数据的最大区域装入数组，我们不能直接把M:N列整列装入数组，那数据量就超级多了，也许会报错。 arr = .Range("M1:N" & lastRow).Value '和值的参照，必须等于其中一个数字 strRef = "," & .Range("K1") & "," '从行方向循环数组，这里lastRow一般应该用Ubound（arr） For i = 1 To lastRow If arr(i, 1) <> "" Then '判断数组第一列的值不为空 For j = 1 To lastRow '再循环数组 If arr(j, 2) <> "" Then '判断数组第一列的值不为空 temp = arr(i, 1) & "," & arr(j, 2) '组合值 '把组合的值分列为一个数组arrTem arrTem = Split(temp, ",") '循环arrTem，把它的各个元素转换为数值后相加，累加到arrResult的第一行。 For m = LBound(arrTem) To UBound(arrTem) total = total + CInt(arrTem(m)) Next If InStr(strRef, "," & total & ",") Then '如果组合值的和值在那几个数字中，则为有效组合，存入数组。 '动态扩展定义数组 ReDim Preserve arrResult(0 To 1, 0 To k) '把arr第一列与第二列的非空元素逐一组合，中间用","隔开，存到arrResult的第二行。 arrResult(0, k) = total arrResult(1, k) = temp k = k + 1 '计数器增加1 End If total = 0 End If Next End If Next '重定义arrTem,使之与arrResult行列转置 '也可以用application.worksheetfunction.transpose函数转置数组，但数据量不能太大 '这里干脆重弄个转置数组，把arrResult的值写到arrTem中 ReDim arrTem(1 To UBound(arrResult, 2) + 1, 1 To 2) For i = 1 To UBound(arrTem) arrTem(i, 1) = arrResult(0, i - 1) arrTem(i, 2) = arrResult(1, i - 1) Next '把arrTem的数据回写到工作表 .Range("O1").Resize(UBound(arrTem), 2) = arrTem End WithEnd Sub
