Texto para Colunas ou Tabela Irregular

matheusgon

(@matheusgon)

Posts: 2

New Member

Topic starter

Boa Noite pessoal!

seguinte

tenho um csv que vem da seguinte forma

a;b;c;d;e; 1,2,3; //fim linha
g;h;i;j;l;m;1,2,3,4,5 //fim linha
n;o;p;q;r;1,2,3,4,5,6,7,8,9;

Letras: dados regulares, ao transformar de texto para colunas
Numeros: dados irregulares, ao transformar em colunas acontece de ter: 1 colunas a ter 20 colunas

o que eu desejo: UMA LUZ rsrsrs

em transformar:

A:B;C;D;E;1;
A;B;C;D;E;2;
A;B;C;D;E;3;
G;H;I;J;L;M;1;
G;H;I;J;L;M;2;
G;H;I;J;L;M;3;
G;H;I;J;L;M;4;
G;H;I;J;L;M;5;

Alguém me socorrer?

de qualquer formar

obrigado!

Postado : 09/05/2017 9:23 pm

matheusgon

(@matheusgon)

Posts: 2

New Member

Topic starter

Sub CONVERTROWSTOCOL_Oeldere_revisted_new()

Dim rsht1 As Long, rsht2 As Long, i As Long, col As Long, wsTest As Worksheet, mr As Worksheet, ms As Worksheet

'check if sheet "ouput" already exist

Const strSheetName As String = "Output"

Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

'set the data
                 

Set mr = Sheets("sheet1")                                  'this is the name of the source sheet
 
Set ms = Sheets("Output")                                       'this is the name of the destiny sheet

col = 2
'End set the data

    With ms
     .UsedRange.ClearContents
     .Range("A1:B1").Value = Array("Mat", "value")
    End With
    
    rsht2 = ms.Range("A" & Rows.Count).End(xlUp).Row
    
    
    With mr
          rsht1 = .Range("A" & .Rows.Count).End(xlUp).Row
          For i = 2 To rsht1
                Do While .Cells(1, col).Value <> "" 'And .Cells(I, col).Value <> ""
                rsht2 = rsht2 + 1
               
                ms.Range("A" & rsht2).Value = .Range("A" & i).Value
                
               
                ms.Range("B" & rsht2).Value = .Cells(i, col).Value
         
                col = col + 1
            Loop
            col = 2
        Next
    End With
    
  With ms
  
  
  
  
    .Columns("A:Z").EntireColumn.AutoFit
    
    End With
    
End Sub

Postado : 10/05/2017 1:52 pm