Results 1 to 7 of 7

Thread: concatenat data's tables

  1. #1

    concatenat data's tables



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hello at all,


    I would like help for concatenation data of 3 tables.
    The first table data is entered manually.

    The second and third table are a result of the first table (i use a macro for this).


    I would like to concatenate in new worksheet the data of this tables in columns as in the attachment.


    Thank for your help.

    Test.xls
    Last edited by yuki; 2014-11-05 at 06:13 PM.

  2. #2
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    Use a recursive function. Haven't finished the Input Output but you should be able to complete it from this
    Also must make sure that the last column is not a blank column

    Code:
    'you could pass this along but coding in a rush
    Public iRows As Long, iCols As Long, iSol As Long
    Public Odata
    Public sResult() As String
    
    
    Sub SetupArray(ByVal rRange As Range)
    Dim i As Long, j As Long, lCnt As Long
    
    
        Odata = rRange.Value2       'get the data to an array
        iRows = UBound(Odata, 1)
        iCols = UBound(Odata, 2)
        
        lCnt = 1                    'work out how many results to get
        For j = 1 To iCols
            For i = 1 To iRows
                If Odata(i, j) = "" Then
                    i = i - 1
                    Exit For
                End If
            Next i
            lCnt = lCnt * i
        Next j
        
        iSol = 1                    'make space for the results
        ReDim sResult(1 To lCnt, 1 To 2)
        
        Call Recursive("", 1)
        
        Sheets("Feuil3").Cells(10, 1).Resize(lCnt, 2).Value2 = sResult      'Need to set where the results go
        
    End Sub
    
    
    Sub Recursive(ByVal STemp As String, jCol As Long)
        For i = 1 To iRows
            If Odata(i, jCol) <> "" Then
                If jCol = iCols Then    'last column so this is a solution
                    sResult(iSol, 1) = Trim(STemp & " " & Odata(i, jCol))
                    iSol = iSol + 1
                Else                    'or keep going
                    Call Recursive(STemp & " " & Odata(i, jCol), jCol + 1)
                End If
            End If
        Next i
    End Sub
    
    
    Sub test()
        Call SetupArray(Sheets("Feuil1").Range("A3:D7"))   'need to set the three tables and call sequentially updating the output range
    End Sub
    Last edited by WizzardOfOz; 2014-11-06 at 08:56 AM.

  3. #3
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    374
    Articles
    0
    Excel Version
    2020
    Never use merged cells in combination with VBA.
    This suffices
    Code:
    Sub tst()
        Feuil1.Cells.UnMerge
        M_snb_002 Feuil1.Cells(3, 1)
        M_snb_002 Feuil1.Cells(3, 6)
        M_snb_002 Feuil1.Cells(3, 11)
    End Sub
    
    Sub M_snb_002(c00)
        sn = c00.CurrentRegion
        
        For j = 1 To UBound(sn)
          If sn(j, 1) <> "" Then
            For jj = 1 To UBound(sn)
                If sn(jj, 2) <> "" Then
                  For jjj = 1 To UBound(sn)
                     If sn(jjj, 3) <> "" Then
                        If UBound(sn, 2) = 3 Then
                              c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3)
                        Else
                            For jjjj = 1 To UBound(sn)
                              If sn(jjjj, 4) <> "" Then c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3) & "_" & sn(jjjj, 4)
                            Next
                        End If
                    End If
                  Next
                End If
            Next
          End If
        Next
        sp = Split(Mid(c01, 2), vbLf)
        
        Feuil2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
    End Sub

  4. #4
    WizzardOfOz and snb thank for your help.

    I will test and analyse the macros. I'll come back to tell you if it's ok.

  5. #5
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    snb,
    Nested for loop is fine for the stated question which has 3 or 4 columns but if this was just an abbreviated example to post it would require more nested for's. In contrast the recursive function is not bound by the number of columns.

    I like the last 2 lines, neat!

  6. #6
    Hi at all,

    I studied snb's macro. It's a very good job!
    I don't understand completly the code but i I proposed to you, an complementary adaptation for 2 columns. It's work fine for me.

    Code:
    Sub tst()
        Feuil1.Cells.UnMerge
        M_snb_002 Feuil1.Cells(3, 1)
        M_snb_002 Feuil1.Cells(3, 6)
        M_snb_002 Feuil1.Cells(3, 11)
        M_snb_002 Feuil1.Cells(3, 15)
    End Sub
    
    Sub M_snb_002(c00)
        sn = c00.CurrentRegion
        
        For j = 1 To UBound(sn)
          If sn(j, 1) <> "" Then
            For jj = 1 To UBound(sn)
                If sn(jj, 2) <> "" Then
                   If UBound(sn, 2) = 2 Then
                         c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2)
                   Else
                       For jjj = 1 To UBound(sn)
                          If sn(jjj, 3) <> "" Then
                             If UBound(sn, 2) = 3 Then
                                   c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3)
                             Else
                                 For jjjj = 1 To UBound(sn)
                                   If sn(jjjj, 4) <> "" Then c01 = c01 & vbLf & sn(j, 1) & "_" & sn(jj, 2) & "_" & sn(jjj, 3) & "_" & sn(jjjj, 4)
                                 Next
                             End If
                          End If
                       Next
                    End If
                End If
            Next
          End If
        Next
               
        sp = Split(Mid(c01, 2), vbLf)
        
        Feuil2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
    End Sub
    Last edited by yuki; 2014-11-07 at 08:52 AM.

  7. #7
    Snb i have a question :

    Why you don't use merged cell in combination with VBA ?

    Thank for your response.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •