[Resolvido]Acrescentar colunas de acordo com linhas

thiagonsilvaa 11/1/2019, 12:32

thiagonsilvaa: Avançado; Respeito às regras :

Sexo :
Localização :
Mensagens : 384
Registrado : 12/01/2017

Mensagem nº1

[Resolvido]Acrescentar colunas de acordo com linhas

Mensagem thiagonsilvaa 11/1/2019, 12:32

Bom dia a todos !

Estive olhando alguns tópicos, mas nenhum me resolveu 100%
Tentei adaptar os códigos contidos neste tópico pra minha necessidade mas não deram certo:

https://www.maximoaccess.com/t1918-resolvidoacrescentar-uma-coluna-a-uma-tabela-ja-existente-via-vba

Eu tenho uma tabela com dados:

[Resolvido]Acrescentar colunas de acordo com linhas Teste10

Gostaria de adicionar colunas de acordo com essas linhas de modo automático.
Tentei fazer um loop mas não consegui.

Gostaria da ajuda de vocês.

Grato desde já !!

thiagonsilvaa 14/1/2019, 13:01

thiagonsilvaa

thiagonsilvaa: Avançado; Respeito às regras :

Sexo :
Localização :
Mensagens : 384
Registrado : 12/01/2017

Mensagem nº2

Re: [Resolvido]Acrescentar colunas de acordo com linhas

Mensagem thiagonsilvaa 14/1/2019, 13:01

Bom dia !
Alguém ?

**Alvaro Teixeira** 14/1/2019, 13:40

Alvaro Teixeira

Alvaro Teixeira: Moderador Global; Respeito às regras :

Sexo :
Localização :
Mensagens : 7995
Registrado : 15/03/2013

Mensagem nº3

Re: [Resolvido]Acrescentar colunas de acordo com linhas

Mensagem Alvaro Teixeira 14/1/2019, 13:40

Olá Thiago,

Veja se é o que pretende:
https://www.maximoaccess.com/t9935-resolvidoconverter-linhas-em-colunas

Caso não atenda, tente a "Busca" aqui do fórum, veja como fazer:
https://www.maximoaccess.com/t1115-busca-no-forum-search

Abraço

thiagonsilvaa 14/1/2019, 16:47

thiagonsilvaa

thiagonsilvaa: Avançado; Respeito às regras :

Sexo :
Localização :
Mensagens : 384
Registrado : 12/01/2017

Mensagem nº4

Re: [Resolvido]Acrescentar colunas de acordo com linhas

Mensagem thiagonsilvaa 14/1/2019, 16:47

Boa tarde !
Primeiramente obrigado pelo retorno.

Estou tentando adaptar esse código a minha necessidade, porém ainda não obtive sucesso:

Código:: Public Function Transposer(strSource As String, strTarget As String) Dim db As Database Dim tdfNewDef As TableDef Dim fldNewField As Field Dim rstSource As Recordset, rstTarget As Recordset Dim i As Integer, j As Integer On Error GoTo Transposer_Err Set db = CurrentDb() Set rstSource = db.OpenRecordset(strSource) rstSource.MoveLast ' Create a new table to hold the transposed data. ' Create a field for each record in the original table. Set tdfNewDef = db.CreateTableDef(strTarget) For i = 0 To rstSource.RecordCount Set fldNewField = tdfNewDef.CreateField(CStr(i + 1), dbText) tdfNewDef.Fields.Append fldNewField Next i db.TableDefs.Append tdfNewDef ' Open the new table and fill the first field with ' field names from the original table. Set rstTarget = db.OpenRecordset(strTarget) For i = 0 To rstSource.Fields.Count - 1 With rstTarget .AddNew .Fields(0) = rstSource.Fields(i).Name .Update End With Next i rstSource.MoveFirst rstTarget.MoveFirst ' Fill each column of the new table ' with a record from the original table. For j = 0 To rstSource.Fields.Count - 1 ' Begin with the second field, because the first field ' already contains the field names. For i = 1 To rstTarget.Fields.Count - 1 With rstTarget .Edit .Fields(i) = rstSource.Fields(j) rstSource.MoveNext .Update End With Next i rstSource.MoveFirst rstTarget.MoveNext Next j db.Close Exit Function Transposer_Err: Select Case Err Case 3010 MsgBox "The table " & strTarget & " already exists." Case 3078 MsgBox "The table " & strSource & " doesn't exist." Case Else MsgBox CStr(Err) & " " & Err.Description End Select Exit Function End Function

thiagonsilvaa 14/1/2019, 17:05

thiagonsilvaa

thiagonsilvaa: Avançado; Respeito às regras :

Sexo :
Localização :
Mensagens : 384
Registrado : 12/01/2017

Mensagem nº5

Re: [Resolvido]Acrescentar colunas de acordo com linhas

Mensagem thiagonsilvaa 14/1/2019, 17:05

Boa tarde.
Consegui chegar nisso:
Mas ainda não é o que preciso, preciso que os valores das colunas virem as colunas em si.

[Resolvido]Acrescentar colunas de acordo com linhas Fields10

O resultado esperado seria esse:

[Resolvido]Acrescentar colunas de acordo com linhas Sem_tz11

Não consegui achar onde está o ponto pra eu fazer a alteração no código.
Se puder me dar uma luz ficarei grato.

**Dilson** 15/1/2019, 01:16

Dilson

Dilson: Developer; Respeito às regras :

Sexo :
Localização :
Mensagens : 1743
Registrado : 11/11/2009

Mensagem nº6

Re: [Resolvido]Acrescentar colunas de acordo com linhas

Mensagem Dilson 15/1/2019, 01:16

Coloque no evento ao clicar de um botão só para testes, depois você melhora-o e incrementa onde quiser:


Dim rs As DAO.Recordset
Dim JuntaNome As String
Dim qArray As Variant
Dim i As Integer

Set rs = CurrentDb.OpenRecordset("SELECT SeuCampo FROM SuaTabela")
If rs.RecordCount > 0 Then
        rs.MoveFirst
        JuntaNome = rs(0)
        rs.MoveNext
Else
        MsgBox "Não há dados para trabalhar. Esta ação será cancelada", vbInformation, "Atenção"
        rs.Close
        Set rs = Nothing
        Exit Sub
End If

Do While Not rs.EOF
        JuntaNome = JuntaNome & ";" & rs(0)
        rs.MoveNext
Loop
rs.Close
Set rs = Nothing

qArray = Split(JuntaNome, ";")
For i = 0 To UBound(qArray)
         CurrentDb.Execute ("ALTER TABLE SuaTabela ADD COLUMN " & qArray(i) & " Text;")
Next i
MsgBox "Concluido."

thiagonsilvaa 15/1/2019, 12:18

thiagonsilvaa

thiagonsilvaa: Avançado; Respeito às regras :

Sexo :
Localização :
Mensagens : 384
Registrado : 12/01/2017

Mensagem nº7

Re: [Resolvido]Acrescentar colunas de acordo com linhas

Mensagem thiagonsilvaa 15/1/2019, 12:18

Bom dia amigos !

Dilson, ficou exatamente como precisava.

A primeira parte já está praticamente concluída agora é partir pra segunda e lutar para o bom funcionamento.

Vou procurar aqui no fórum as outras dúvidas que tiver, caso necessário, abro um outro tópico.

Muito obrigado a todos pela ajuda !

Abraços.

cheers