MACRO ORGANIZAR RELATÓRIO NÃO ESTA FUNCIONANDO

JSILVA 28/07/2015 15:35:54
#449313
Olá pessoal sou leigo no VBA Excel, e fiz uma macro para organizar o relatório do sistema da empresa onde eu trabalho, já fiz em outros relatórios, e deu certo, mas este não esta funcionando, poderiam dar uma olhada e ver onde estou errando?

jsilva
TUNUSAT 28/07/2015 15:42:40
#449316 Resposta escolhida
JSILVA,

Antes de abrir o arquivo, queria saber que tipo de [Ô]organização[Ô] você quer fazer...

[][ô]s,
Tunusat.
JSILVA 28/07/2015 16:20:14
#449319
TUNUSAT, boa tarde

Quando exporto um relatório do sistema da empresa para Excel, ele vem todo desorganizado e as vezes o que é número vem em forma de texto, para fazer os controles preciso organizá-lo de forma que valores em texto se torne números para efetuar cálculos.


jsilva
TUNUSAT 29/07/2015 06:27:10
#449345
JSILVA,

Clicando no [Ô]rostinho vermelho[Ô], este código que fica somando linha até [Ô]532[Ô]... depois faz estas duas linhas:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Quando o código para, fecha a planilha.
E não faz mais nada?!? Não entendi... Você quer pegar o conteúdo da primeira pasta e colunar na segunda?!?

=================================================
IMP_RED.xlms - Módulo1 (Código)
--------------------------------------------------------------------------------------
Sub OrgRed()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

[ô]DEFINIÇÃO DAS VARIAVEIS
Dim o           As Worksheet
Dim d           As Worksheet
Dim linha
Dim linhaori
Dim HrI         As String
Dim HrF         As String
Dim DtI         As String
Dim DtF         As String
Dim Perm        As String
Dim Cap         As String
Dim Real        As String
Dim Nom         As String
Dim Eq          As String
Dim Obs         As String
Dim Mot         As String
Dim Sol         As String



[ô]DEFINIÇÃO DOS VALORES DAS VARIAVEIS

Set o = Sheets([Ô]IMP_RED[Ô]) [ô]codificação do nome da aba origem
Set d = Sheets([Ô]Relatório[Ô]) [ô]codificação do nome da aba destino
linha = 2 [ô]linha de inicio do relatório organizado
linhaori = 12 [ô]linha de inicio de verificação do relatório original
d.Columns([Ô]S:S[Ô]).ClearContents [ô]limpar a coluna de contagem das linhas validas

[ô]INICIO DA AÇÃO
While (d.Cells(linha, 1) <> [Ô][Ô])
 
     linha = linha + 1
Wend

d.Cells(linha, 1).Select

    While (o.Cells(linhaori, 1).Text <> [Ô]FIM[Ô])
      If Mid(o.Cells(linhaori, 1).Value, 3, 1) = [Ô]:[Ô] Then HrI = o.Cells(linhaori, 1)
            If Mid(o.Cells(linhaori, 2).Value, 3, 1) = [Ô]:[Ô] Then HrF = o.Cells(linhaori, 2)
                If Mid(o.Cells(linhaori, 3).Value, 3, 1) = [Ô]:[Ô] Then Perm = o.Cells(linhaori, 3)
                    linhaori = linhaori + 1
      If Mid(o.Cells(linhaori, 1).Value, 3, 1) = [Ô]/[Ô] Then DtI = o.Cells(linhaori, 1)
            If Mid(o.Cells(linhaori, 2).Value, 3, 1) = [Ô]/[Ô] Then DtF = o.Cells(linhaori, 2)
                If Mid(o.Cells(linhaori, 3).Value, 1, 1) = [Ô],[Ô] Then Cap = o.Cells(linhaori, 3)
                    If Mid(o.Cells(linhaori, 4).Value, 4, 1) = [Ô],[Ô] Then Real = o.Cells(linhaori, 4)
                        If Len(o.Cells(linhaori, 4).Value) = 3 Then Real = o.Cells(linhaori, 4)
                            If Len(o.Cells(linhaori, 5).Value) = 3 Then Nom = o.Cells(linhaori, 5)
                                linhaori = linhaori + 2
      If Right(o.Cells(linhaori, 1), 3) = [Ô]UVA[Ô] Then Eq = o.Cells(linhaori, 1)
            If Mid(o.Cells(linhaori, 2).Value, 5, 1) = [Ô]-[Ô] Then Mot = o.Cells(linhaori, 2)
                If Mid(o.Cells(linhaori, 4).Value, 4, 1) = [Ô]-[Ô] Then Sol = o.Cells(linhaori, 4)
                    linhaori = linhaori + 4
      If o.Cells(linhaori, 1).Value = [Ô]Observações[Ô] Then Obs = o.Cells(linhaori - 1, 1)
      If o.Cells(linhaori - 1, 1).Value = [Ô]Moenda[Ô] Then
            d.Cells(linha, 1).Value = UCase(Trim(Eq)) [ô]Moenda
            d.Cells(linha, 3).Value = UCase(Trim(Mot)) [ô]Motivo
            d.Cells(linha, 4).Value = UCase(Trim(Sol)) [ô]Solicitante
            d.Cells(linha, 5).Value = UCase(Trim(Obs)) [ô]Observação
            d.Cells(linha, 6).Value = CDate(DtI) [ô]data inicial
            d.Cells(linha, 7).Value = HrI [ô]hora inicial
            d.Cells(linha, 8).Value = CDate(DtF) [ô]data final
            d.Cells(linha, 9).Value = HrF [ô]hora final
            d.Cells(linha, 10).Value = Cap [ô]capacidade
            d.Cells(linha, 11).Value = Perm [ô]tempo de permanência
            d.Cells(linha, 12).Value = Real [ô]moagem real / hora
            d.Cells(linha, 13).Value = Nom [ô]moagem nominal / hora
            d.Cells(linha, 21).Value = 1 [ô]insere na célula o valor 1
            d.Cells(linha, 2).Select [ô] seleciona a celula
            linha = linha + 1
        Else
            linhaori = linhaori + 1
        End If
          
    Wend
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

=================================================

=================================================
Power Translator.xla - Module1 (Código)
--------------------------------------------------------------------------------------
Private Obj As LogoMediaDotNetAddInLib.LMDNAddIn
Private a() As Variant
Sub AutoExit()
ReDim a(1)
If Not Obj Is Nothing Then Call Obj.OnDisconnection(RemoveMode:=ext_dm_HostShutdown, custom:=a)
Set Obj = Nothing
End Sub
Sub AutoExec()
ReDim a(1)
Set Obj = CreateObject([Ô]LogoMediaDotNetAddIn.LMDNAddIn[Ô])
DoEvents
If Not Obj Is Nothing Then Call Obj.OnConnection(Application:=Excel.Application, ConnectMode:=2, AddInInst:=Obj, custom:=a)
End Sub
Sub TranslateAll()
If Not Obj Is Nothing Then Call Obj.TranslateAllClick
End Sub
Sub TranslateSel()
If Not Obj Is Nothing Then Call Obj.TranslateSelClick
End Sub
Sub LPChange()
Dim a As String
a = Application.CommandBars.ActionControl.Tag
If Not Obj Is Nothing Then Call Obj.LangPairChange(Tag:=a)
End Sub
Sub LPShow()
If Not Obj Is Nothing Then Call Obj.ShowLP(x:=Application.CommandBars.ActionControl.Left, y:=Application.CommandBars.ActionControl.Top + Application.CommandBars.ActionControl.Height)
End Sub

=================================================

=================================================
Power Translator.xla - ThisWorkBook (Código)
--------------------------------------------------------------------------------------
[ô]Other variables
Sub Workbook_BeforeClose(cancel As Boolean)
    Call AutoExit
End Sub
Sub Workbook_AddinUninstall()
    Call AutoExit
End Sub


Sub Workbook_Open()
    Call AutoExec
End Sub
Private Sub Workbook_AddInInstall()
        Call AutoExec
End Sub

=================================================

[][ô]s,
Tunusat.
JSILVA 29/07/2015 08:20:58
#449349
TUNUSAT bom dia,

E isso mesmo, quero organizar da aba IMP_RED para aba Relatório.
Não entendi o código que você postou, e para resolver meu problema.

jsilva
TUNUSAT 29/07/2015 22:51:13
#449376
JSILVA,

Eu estava depurando o código e resolvi comentar este [Ô]IF[Ô] / [Ô]ELSE[Ô] / [Ô]ENDIF[Ô]:
If o.Cells(linhaori - 1, 1).Value = [Ô]Moenda[Ô] Then


Mas mantive o contador:
linhaori = linhaori + 1


Percebi que ele carrega todas as linhas ... mas será que está correto?!? Não sei ... veja.

O detalhe é que ele está pulando as linhas incorretamente.
Ele tenta achar a palavra [Ô]Moenda[Ô] na posição ...
o.Cells(19 - 1, 1).Value
... como não consegue, ele pula para:
o.Cells(27 - 1, 1).Value
E assim vai:
o.Cells(35 - 1, 1).Value
o.Cells(43 - 1, 1).Value
o.Cells(51 - 1, 1).Value
o.Cells(59 - 1, 1).Value

Sempre somando + 8 e NUNCA achando a palavra [Ô]Moenda[Ô].
O que precisa ser feito é posicionar a variável [Ô]linhaori[Ô] para que pule para a posição correta.
Veja se está certo:
Sub OrgRed()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

[ô]DEFINIÇÃO DAS VARIAVEIS
Dim o           As Worksheet
Dim d           As Worksheet
Dim linha
Dim linhaori
Dim HrI         As String
Dim HrF         As String
Dim DtI         As String
Dim DtF         As String
Dim Perm        As String
Dim Cap         As String
Dim Real        As String
Dim Nom         As String
Dim Eq          As String
Dim Obs         As String
Dim Mot         As String
Dim Sol         As String

[ô]DEFINIÇÃO DOS VALORES DAS VARIAVEIS
    Set o = Sheets([Ô]IMP_RED[Ô]) [ô]codificação do nome da aba origem
    Set d = Sheets([Ô]Relatório[Ô]) [ô]codificação do nome da aba destino
    linha = 2 [ô]linha de inicio do relatório organizado
    linhaori = 12 [ô]linha de inicio de verificação do relatório original
    d.Columns([Ô]S:S[Ô]).ClearContents [ô]limpar a coluna de contagem das linhas validas

    [ô]INICIO DA AÇÃO
    While (d.Cells(linha, 1) <> [Ô][Ô])
         linha = linha + 1
    Wend
    
    d.Cells(linha, 1).Select

    While (o.Cells(linhaori, 1).Text <> [Ô]FIM[Ô])
        If Mid(o.Cells(linhaori, 1).Value, 3, 1) = [Ô]:[Ô] Then HrI = o.Cells(linhaori, 1)
        If Mid(o.Cells(linhaori, 2).Value, 3, 1) = [Ô]:[Ô] Then HrF = o.Cells(linhaori, 2)
        If Mid(o.Cells(linhaori, 3).Value, 3, 1) = [Ô]:[Ô] Then Perm = o.Cells(linhaori, 3)
        linhaori = linhaori + 1
      
        If Mid(o.Cells(linhaori, 1).Value, 3, 1) = [Ô]/[Ô] Then DtI = o.Cells(linhaori, 1)
        If Mid(o.Cells(linhaori, 2).Value, 3, 1) = [Ô]/[Ô] Then DtF = o.Cells(linhaori, 2)
        If Mid(o.Cells(linhaori, 3).Value, 1, 1) = [Ô],[Ô] Then Cap = o.Cells(linhaori, 3)
        If Mid(o.Cells(linhaori, 4).Value, 4, 1) = [Ô],[Ô] Then Real = o.Cells(linhaori, 4)
        If Len(o.Cells(linhaori, 4).Value) = 3 Then Real = o.Cells(linhaori, 4)
        If Len(o.Cells(linhaori, 5).Value) = 3 Then Nom = o.Cells(linhaori, 5)
        linhaori = linhaori + 1
      
        If InStr(1, o.Cells(linhaori, 1).Value, [Ô]MOENDA[Ô]) > 0 Then
            d.Cells(linha, 1).Value = UCase(Trim(Eq)) [ô]Moenda
            d.Cells(linha, 3).Value = UCase(Trim(Mot)) [ô]Motivo
            d.Cells(linha, 4).Value = UCase(Trim(Sol)) [ô]Solicitante
            d.Cells(linha, 5).Value = UCase(Trim(Obs)) [ô]Observação
            d.Cells(linha, 6).Value = CDate(DtI) [ô]data inicial
            d.Cells(linha, 7).Value = HrI [ô]hora inicial
            d.Cells(linha, 8).Value = CDate(DtF) [ô]data final
            d.Cells(linha, 9).Value = HrF [ô]hora final
            d.Cells(linha, 10).Value = Cap [ô]capacidade
            d.Cells(linha, 11).Value = Perm [ô]tempo de permanência
            d.Cells(linha, 12).Value = Real [ô]moagem real / hora
            d.Cells(linha, 13).Value = Nom [ô]moagem nominal / hora
            d.Cells(linha, 21).Value = 1 [ô]insere na célula o valor 1
            d.Cells(linha, 2).Select [ô] seleciona a celula
            linha = linha + 1
        End If

        If Right(o.Cells(linhaori, 1), 3) = [Ô]UVA[Ô] Then Eq = o.Cells(linhaori, 1)
        If Mid(o.Cells(linhaori, 2).Value, 5, 1) = [Ô]-[Ô] Then Mot = o.Cells(linhaori, 2)
        If Mid(o.Cells(linhaori, 4).Value, 4, 1) = [Ô]-[Ô] Then Sol = o.Cells(linhaori, 4)
        linhaori = linhaori + 2
        
        If o.Cells(linhaori, 1).Value = [Ô]Observações[Ô] Then Obs = o.Cells(linhaori - 1, 1)
        linhaori = linhaori + 1
    Wend
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub


Ixi! Tem um ponto que ele precisa pular um cabeçalho!

[][ô]s,
Tunusat.
JSILVA 30/07/2015 20:08:30
#449416
TUNUSAT, não deu muito certo, na primeira linha de destino ficou faltando informações em algumas colunas e o restante dos dados de origem não foram para a aba destino.

Como você montaria esta organização de dados para a aba (Relatório).?

jsilva
JSILVA 30/07/2015 20:10:02
#449417
TUNUSAT, não deu muito certo, na primeira linha de destino ficou faltando informações em algumas colunas e o restante dos dados de origem não foram para a aba destino.

Como você montaria esta organização de dados para a aba (Relatório).?

jsilva
Tópico encerrado , respostas não são mais permitidas
Voltar