Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Adaptar Parte Códig...
 
Notifications
Clear all

Adaptar Parte Código Loop

 
2024 - VBA & Macros
Post Recente por romanholi 8 anos atrás
9 Posts
2 Usuários
0 Reactions
1,746 Visualizações
RSS
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

Pessoal, bom dia!

Tenho um formulário para cadastro e agora surgiu um problema. Tenho uma questão neste formulário que pode ter até 10 comentário na sua resposta. Eu preciso cadastrar na minha base de dados, porém preciso que ele cadastre os comentário linha a linha. Como eu fiz no código abaixo, porém eu preciso que ele repita as demais informações, ou seja, que ele repita todas as colunas que não a coluna (8) do comentário (CMTS_Q002_01......CMTS_Q002_10):

Imagino que seja necessário o código ler quantos comentário tem e depois utilizar uma estrutura de repetição. Tipo:

For i = 0 To Quantidade de linhas preenchidas

Next

Mas eu não consegui.

Será que vocês poderiam me ajudar adaptando o código abaixo:

With wsCadastroQ001
        
        Dim LR As Integer
        
        LR = .Cells(65536, 10).End(xlUp).Offset(1, 0).Row 'define ultima linha vazia
        
        
        .Cells(LR, 1).Value = id
        .Cells(LR, 2).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 3).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 4).Value = Sheets("Pesquisa").Range("EMPRESA")
        .Cells(LR, 5).Value = Sheets("Pesquisa").Range("REGIONAL")
        .Cells(LR, 6).Value = Sheets("Pesquisa").Range("ENCOMENDA")
        .Cells(LR, 7).Value = Sheets("Pesquisa").Range("CARRO")
        
        .Cells(LR + 1, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_01")
        .Cells(LR + 2, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_02")
        .Cells(LR + 3, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_03")
        .Cells(LR + 4, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_04")
        .Cells(LR + 5, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_05")
        .Cells(LR + 6, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_06")
        .Cells(LR + 7, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_07")
        .Cells(LR + 8, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_08")
        .Cells(LR + 9, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_09")
        .Cells(LR + 10, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_10")
        
        .Cells(LR, 9).Value = Sheets("Pesquisa").Range("Q002_QTDE")
        .Cells(LR, 10).Value = Sheets("Pesquisa").Range("QUANTIDADE")
        .Cells(LR, 11).Value = Sheets("Pesquisa").Range("TAB_Q021")
        
        .Cells(LR, 13).Value = Sheets("Pesquisa").Range("TECNICO")
        .Cells(LR, 16).Value = Sheets("Pesquisa").Range("CONTATO")
        .Cells(LR, 17).Value = Sheets("Pesquisa").Range("CARGO")
        
     
           'oculta a janela
    wbCadastro.Windows(1).Visible = True


Sheets("Base_Dados").Select


           'oculta a janela
    wbCadastro.Windows(1).Visible = False
        
        
End With

Obrigado Galera
Mais uma

 
Postado : 07/03/2017 1:39 pm
 JPedro
(@jpedro)
Posts: 0
New Member
 

Boa noite.

Veja se é isso e adapte conforme a sua necessidade. Levei em conta que o final dos comentários é numérico e sempre em ordem crescente. E considerei tbm que tem sempre dez. Caso a quantidade mude, vc precisará ter algo que conte essa quantidade e a transforme depois em variável (ex.: For d=1 To QtdComentarios).

With wsCadastroQ001
        
        Dim LR As Integer
        
        For d = 1 To 10
        
        LR = .Cells(65536, 10).End(xlUp).Offset(1, 0).Row 'define ultima linha vazia
        
        If d < 10 Then dig = "0" & d
        If d >= 10 Then dig = d
                
        .Cells(LR, 1).Value = ID
        .Cells(LR, 2).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 3).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 4).Value = Sheets("Pesquisa").Range("EMPRESA")
        .Cells(LR, 5).Value = Sheets("Pesquisa").Range("REGIONAL")
        .Cells(LR, 6).Value = Sheets("Pesquisa").Range("ENCOMENDA")
        .Cells(LR, 7).Value = Sheets("Pesquisa").Range("CARRO")
        
        .Cells(LR, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_" & dig)
        
        .Cells(LR, 9).Value = Sheets("Pesquisa").Range("Q002_QTDE")
        .Cells(LR, 10).Value = Sheets("Pesquisa").Range("QUANTIDADE")
        .Cells(LR, 11).Value = Sheets("Pesquisa").Range("TAB_Q021")
        .Cells(LR, 13).Value = Sheets("Pesquisa").Range("TECNICO")
        .Cells(LR, 16).Value = Sheets("Pesquisa").Range("CONTATO")
        .Cells(LR, 17).Value = Sheets("Pesquisa").Range("CARGO")
        
     
     Next d
     
           'oculta a janela
    wbCadastro.Windows(1).Visible = True

    Sheets("Base_Dados").Select

           'oculta a janela
    wbCadastro.Windows(1).Visible = False
        
        
End With
 
Postado : 07/03/2017 8:35 pm
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

JPedro, bom dia e obrigado pela resposta!

É quase isso, porém ele está repetindo as outras colunas 10 vezes, quando na verdade ele deveria repetir apenas a quantidade de comentários que eu tiver, veja na imagem que demonstro anexo.
As linhas em amarelo também não deveriam ter sido cadastradas!

Acho que está parte For D = 1 To 10 deveria ser variável o 10, mandando contar na minha planilha Pesquisa das células B16:B25 quantos valores tem! Daí ele ficaria variável!

Quando fui executar ele pediu para que e declarasse as variáveis. Fiz da forma abaixo e rodou:

Dim D As Long
Dim dig As String

Mas está com esse problema de criar sempre 10 linhas... teria que criar a quantidade de comentários que tem!

Poderia me ajudar meu amigo!

Obrigado

 
Postado : 08/03/2017 4:40 am
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

Estou tentando fazer assim, mas não está contando corretamente:

With wsCadastroQ002
        
        Dim LR As Integer
        Dim D As Long
        Dim dig As String
        Dim Qtde As Long
        
        Qtde = Worksheets("Pesquisa").Range("B16:B25").Cells.SpecialCells(xlCellTypeConstants).Count
        
        MsgBox Qtde
        
        
        For D = 1 To Qtde
        
        LR = .Cells(65536, 10).End(xlUp).Offset(1, 0).Row 'define ultima linha vazia
        
        If D < Qtde Then dig = "0" & D
        If D >= Qtde Then dig = D
                
        .Cells(LR, 1).Value = id
        .Cells(LR, 2).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 3).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 4).Value = Sheets("Pesquisa").Range("EMPRESA")
        .Cells(LR, 5).Value = Sheets("Pesquisa").Range("REGIONAL")
        .Cells(LR, 6).Value = Sheets("Pesquisa").Range("ENCOMENDA")
        .Cells(LR, 7).Value = Sheets("Pesquisa").Range("CARRO")
        
        .Cells(LR, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_" & dig)
        
        .Cells(LR, 9).Value = Sheets("Pesquisa").Range("Q002_QTDE")
        .Cells(LR, 10).Value = Sheets("Pesquisa").Range("QUANTIDADE")
        .Cells(LR, 11).Value = Sheets("Pesquisa").Range("TAB_Q021")
        .Cells(LR, 13).Value = Sheets("Pesquisa").Range("TECNICO")
        .Cells(LR, 16).Value = Sheets("Pesquisa").Range("CONTATO")
        .Cells(LR, 17).Value = Sheets("Pesquisa").Range("CARGO")
        
     
     Next D
     
           'oculta a janela
    wbCadastro.Windows(1).Visible = True

    Sheets("Base_Dados").Select

           'oculta a janela
    wbCadastro.Windows(1).Visible = False
        
        
End With
 
Postado : 08/03/2017 5:17 am
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

Qtde = Worksheets("Pesquisa").Range("B16:B25").Cells.SpecialCells(xlCellTypeConstants).Count

Já detectei o problema... ele conta, porém minhas células estão mescladas... daí ele conta as contantes, porem multiplica pela quantidade de colunas que eu mesclei!

Mas estou próximo de resolver kkk

 
Postado : 08/03/2017 5:23 am
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

Consegui. Mas tive que trabalhar com as células desmescladas!

Veja o código:

With wsCadastroQ002
        
        Dim LR As Integer
        Dim D As Long
        Dim dig As String
        Dim Qtde As Long
        
        Qtde = Worksheets("Pesquisa").Range("B16:B25").Cells.SpecialCells(xlCellTypeConstants).Count
           
        
        For D = 1 To Qtde
        
        LR = .Cells(65536, 10).End(xlUp).Offset(1, 0).Row 'define ultima linha vazia
        
        If D < 10 Then dig = "0" & D
        If D >= 10 Then dig = D
                
        .Cells(LR, 1).Value = id
        .Cells(LR, 2).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 3).Value = Sheets("Pesquisa").Range("DATA_LIGACAO")
        .Cells(LR, 4).Value = Sheets("Pesquisa").Range("EMPRESA")
        .Cells(LR, 5).Value = Sheets("Pesquisa").Range("REGIONAL")
        .Cells(LR, 6).Value = Sheets("Pesquisa").Range("ENCOMENDA")
        .Cells(LR, 7).Value = Sheets("Pesquisa").Range("CARRO")
        
        .Cells(LR, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_" & dig)
        
        .Cells(LR, 9).Value = Sheets("Pesquisa").Range("Q002_QTDE")
        .Cells(LR, 10).Value = Sheets("Pesquisa").Range("QUANTIDADE")
        .Cells(LR, 11).Value = Sheets("Pesquisa").Range("TAB_Q021")
        .Cells(LR, 13).Value = Sheets("Pesquisa").Range("TECNICO")
        .Cells(LR, 16).Value = Sheets("Pesquisa").Range("CONTATO")
        .Cells(LR, 17).Value = Sheets("Pesquisa").Range("CARGO")
        
     
     Next D
     
           'oculta a janela
    wbCadastro.Windows(1).Visible = True

    Sheets("Base_Dados").Select

           'oculta a janela
    wbCadastro.Windows(1).Visible = False
        
        
End With

Obrigado

 
Postado : 08/03/2017 5:34 am
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

Pessoal, boa tarde!

O código abaixo está me atendendo, porém, quando eu não lanço nenhuma informação, quando o código manda contar as células que tem valores (contantes) dá problema na macro.

Tentei utilizar o On Error GoTo, mas não consegui.

Poderiam me ajudar:

With wsCadastroQ002
        
        Dim LR002 As Integer
        Dim D002 As Long
        Dim dig002 As String
        Dim Qtde002 As Long
        
       

       
        Qtde002 = Worksheets("Pesquisa").Range("B16:B25").Cells.SpecialCells(xlCellTypeConstants).Count
        

           
        
        For D002 = 1 To Qtde002
        
        LR002 = .Cells(65536, 1).End(xlUp).Offset(1, 0).Row 'define ultima linha vazia
        
        If D002 < 10 Then dig002 = "0" & D002
        If D002 >= 10 Then dig002 = D002
                
        .Cells(LR002, 1).Value = indice - 2
        .Cells(LR002, 2).Value = Year(Sheets("Pesquisa").Range("DATA_LIGACAO"))
        .Cells(LR002, 3).Value = Month(Sheets("Pesquisa").Range("DATA_LIGACAO"))
        .Cells(LR002, 4).Value = Sheets("Pesquisa").Range("EMPRESA")
        .Cells(LR002, 5).Value = Sheets("Pesquisa").Range("REGIONAL")
        .Cells(LR002, 6).Value = Sheets("Pesquisa").Range("ENCOMENDA")
        .Cells(LR002, 7).Value = Sheets("Pesquisa").Range("CARRO")
        
        .Cells(LR002, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_" & dig002)
        
        .Cells(LR002, 9).Value = Sheets("Pesquisa").Range("Q002_QTDE")
        .Cells(LR002, 10).Value = Sheets("Pesquisa").Range("QUANTIDADE")
        .Cells(LR002, 11).Value = Sheets("Pesquisa").Range("TAB_Q021")
        .Cells(LR002, 13).Value = Sheets("Pesquisa").Range("TECNICO")
        .Cells(LR002, 16).Value = Sheets("Pesquisa").Range("CONTATO")
        .Cells(LR002, 17).Value = Sheets("Pesquisa").Range("CARGO")
        
       
        
        
     
     Next D002
     

End With

O problema é na linha:

Qtde002 = Worksheets("Pesquisa").Range("B16:B25").Cells.SpecialCells(xlCellTypeConstants).Count

Quando eu deixo o range B16:B25 vazio!
Quando estiver vazio, tem que cadastrar normalmente as informações.

A variável Qtde002 tem que igual a 1

Me ajuda Galera!

Obrigado

 
Postado : 08/03/2017 12:56 pm
 JPedro
(@jpedro)
Posts: 0
New Member
 

romanholi, boa noite.

Acho que a adaptação abaixo resolve o impasse. Veja que estou usando o Application.WorksheetFunction.CountA para ter a quantidade de células não vazias no Range("B16:B25").

With wsCadastroQ002
        
Dim LR002 As Integer
Dim D002 As Long
Dim dig002 As String
Dim Qtde002 As Long
        
Qtde002 = Application.WorksheetFunction.CountA(Range("B16:B25"))
        
If Qtde002 = 0 Then Qtde002 = 1
           
    For D002 = 1 To Qtde002
        
        LR002 = .Cells(65536, 1).End(xlUp).Offset(1, 0).Row 'define ultima linha vazia
        
        If D002 < 10 Then dig002 = "0" & D002
        If D002 >= 10 Then dig002 = D002
                
        .Cells(LR002, 1).Value = indice - 2
        .Cells(LR002, 2).Value = Year(Sheets("Pesquisa").Range("DATA_LIGACAO"))
        .Cells(LR002, 3).Value = Month(Sheets("Pesquisa").Range("DATA_LIGACAO"))
        .Cells(LR002, 4).Value = Sheets("Pesquisa").Range("EMPRESA")
        .Cells(LR002, 5).Value = Sheets("Pesquisa").Range("REGIONAL")
        .Cells(LR002, 6).Value = Sheets("Pesquisa").Range("ENCOMENDA")
        .Cells(LR002, 7).Value = Sheets("Pesquisa").Range("CARRO")
        
        .Cells(LR002, 8).Value = Sheets("Pesquisa").Range("CMTS_Q002_" & dig002)
        
        .Cells(LR002, 9).Value = Sheets("Pesquisa").Range("Q002_QTDE")
        .Cells(LR002, 10).Value = Sheets("Pesquisa").Range("QUANTIDADE")
        .Cells(LR002, 11).Value = Sheets("Pesquisa").Range("TAB_Q021")
        .Cells(LR002, 13).Value = Sheets("Pesquisa").Range("TECNICO")
        .Cells(LR002, 16).Value = Sheets("Pesquisa").Range("CONTATO")
        .Cells(LR002, 17).Value = Sheets("Pesquisa").Range("CARGO")
              
     Next D002
     
End With

Obs.: Se resolveu ou ajudou, clique no joinha acima.

Abraços, cara! Qlq coisa, é só falar.

 
Postado : 08/03/2017 5:49 pm
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

JPedro, muitíssimo obrigado!
Resolveu sim. PERFEITO! OBRIGADO

 
Postado : 09/03/2017 5:39 am
Forum Jump:
  Tópico Anterior
Próximo Tópico