vbscript 整理两个变量以输出所有可能的组合

Posted 2021-05-22

Sub Collater()

'You will have a two-column data table (with headers) and as many rows as you want.
'It doesn't matter whether your data consists of text or number - no "calculation" is run directly on the values.
'You want to "multiply out" your data to get all possible combinations.
'Ordering: Column A for the variable to repeat multiple times (e.g. Alice, Alice, Alice, Bob, Bob, Bob)
'Ordering: Column B for the variable to display in sequence (e.g. 15, 20, 30, 15, 20, 30)
'Leave first row blank

Dim wb As Workbook
Dim ws As Worksheet
Dim k, p, i As Integer
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

Application.ScreenUpdating = False

'The value 'k' is the total count of values in column A.
'The value 'p' is the total count of values in column B.
'The value 'i' shows the total number of combinations of your two variables - simple multiplification.

k = ws.Application.CountA(Range("A:A"))
p = ws.Application.CountA(Range("B:B"))
i = k * p

'Prints these values on the header row of your first three columns.

Range("A1").Value = k
Range("B1").Value = p
Range("C1").Value = i

'The commented column immediately below is an alternative method using formulas instead of VBA code - just ignore.
'Range("A1").Formula = "=COUNTA(A2:A9999)"
'Range("B1").Formula = "=COUNTA(B2:B9999)"
'Range("A1").Copy
'Range("A1").PasteSpecial (xlPasteValues)
'Range("B1").Copy
'Range("B1").PasteSpecial (xlPasteValues)
'Range("C1").Formula = "=A1*B1"
'i = Range("C1")

'The output would appear in Columns D and E.
'Please ensure you save your work first!
'Column references may be changed to suit your needs.

Range("D:D").ClearContents
Range("E:E").ClearContents

Range("D1").Value = "Col1"
Range("E1").Value = "Col2"

Range("D2").Formula = "=INDIRECT(""A""&IF(MOD(ROW(A1),$B$1)=0,QUOTIENT(ROW(A1),$B$1)+1,QUOTIENT(ROW(A1),$B$1)+2))"
Range("D2").Select
Range("D2").Copy
Range("D2").Resize(i, 1).PasteSpecial (xlPasteAll)

Range("E2").Formula = "=IF(MOD(ROW(B1),$B$1)=0,INDIRECT(""B""&$B$1+1),INDIRECT(""B""&MOD(ROW(B1),$B$1)+1))"
Range("E2").Select
Range("E2").Copy
Range("E2").Resize(i, 1).PasteSpecial (xlPasteAll)
Range("A1").Select

Application.ScreenUpdating = True

MsgBox "All done mate."

End Sub