开发者

Macro to make all possible combinations of data in various columns in excel sheet

I am a complete novice at macros and have been given a task which if done manually, can take a lot of time. I have a worksheet which has data as below:

A                      B           C
abc,def,ghi,jkl      1,2,3     a1,e3,h5,j8

I would like this to be in the following format.

abc  1  a1
ab开发者_开发百科c  2  a1
abc  3  a1
abc  1  e3
abc  2  e3
abc  3  h5

and so on to make all possible combinations. Any help will be great. Thanks


Alternative method

Private Sub Combinations()
Dim arrA() As String, arrB() As String, arrC() As String
Dim lngA As Long, lngB As Long, lngC As Long

With Sheet1  '(CHANGE SHEET IF REQUIRED)
   arrA = Split(.Range("A1"), ",")
   arrB = Split(.Range("B1"), ",")
   arrC = Split(.Range("C1"), ",")

   For lngA = LBound(arrA) To UBound(arrA)
     For lngB = LBound(arrB) To UBound(arrB)
        For lngC = LBound(arrC) To UBound(arrC)

        .Range("I" & .Rows.Count).End(xlUp).Offset(1, 0).Value = arrA(lngA) & " " & arrB(lngB) &       " " & arrC(lngC)
        Next lngC
      Next lngB
    Next lngA
End With
End Sub


This code will take the data from columns A, B, and C, and give the output you described in columns E, F, and G.

Sub combinations()

Dim c1() As Variant
Dim c2() As Variant
Dim c3() As Variant
Dim out() As Variant
Dim j, k, l, m As Long


Dim col1 As Range
Dim col2 As Range
Dim col3 As Range
Dim out1 As Range


Set col1 = Range("A1", Range("A1").End(xlDown))
Set col2 = Range("B1", Range("B1").End(xlDown))
Set col3 = Range("C1", Range("C1").End(xlDown))

c1 = col1
c2 = col2
c3 = col3

Set out1 = Range("E2", Range("G2").Offset(UBound(c1) * UBound(c2) * UBound(c3)))
out = out1

j = 1
k = 1
l = 1
m = 1


Do While j <= UBound(c1)
    Do While k <= UBound(c2)
        Do While l <= UBound(c3)
            out(m, 1) = c1(j, 1)
            out(m, 2) = c2(k, 1)
            out(m, 3) = c3(l, 1)
            m = m + 1
            l = l + 1
        Loop
        l = 1
        k = k + 1
    Loop
    k = 1
    j = j + 1
Loop


out1.Value = out
End Sub

If on the other hand, your data is comma-separated in cells A1, B1, and C1, the following code will work similarly.

Sub combinations()

Dim c1() As String
Dim c2() As String
Dim c3() As String
Dim out() As Variant
Dim j, k, l, m As Long


Dim col1 As Range
Dim col2 As Range
Dim col3 As Range
Dim out1 As Range


Set col1 = Range("A1")
Set col2 = Range("B1")
Set col3 = Range("C1")

c1 = Split(col1.Value, ",")
c2 = Split(col2.Value, ",")
c3 = Split(col3.Value, ",")

Set out1 = Range("E1", Range("G1").Offset((UBound(c1) + 1) * (UBound(c2) + 1) * (UBound(c3) + 1)))
out = out1

j = 0
k = 0
l = 0
m = 1


Do While j <= UBound(c1)
    Do While k <= UBound(c2)
        Do While l <= UBound(c3)
            out(m, 1) = c1(j)
            out(m, 2) = c2(k)
            out(m, 3) = c3(l)
            m = m + 1
            l = l + 1
        Loop
        l = 0
        k = k + 1
    Loop
    k = 0
    j = j + 1
Loop
out1.Value = out
End Sub
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜