Usuário com melhor resposta
Rotina não executa

Pergunta
-
Boa tarde pessoas,
Elaborei uma macro que deve incrementar uma planilha existente. Esta faza tudo perfeitamente, quase tudo, deleta a base antiga, importa a nova, e acrescenta o items pedidos nas posições corretas.
Porém não executa determinado loop que deve preencher alguns espaços vazios. Não execulta quando mando execultar(jura...) a macro. Mas quando testo linha a linha, utilizando F8, a rotina funciona normalmente, alguem pode me ajudar a descobrir o que há de errado?
Segue o código:
Sub add() Application.ScreenUpdating = False '-------Deleta BASE antiga e abre nova--------- Sheets("Base").Delete Sheets.add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Select Sheets(Sheets.Count).Name = "Base" Dim linha As Variant Dim w As Long Dim arquivo As String arquivo = Application.GetOpenFilename("(*.txt),*.txt") Open arquivo For Input As #1 w = 1 While Not EOF(1) Line Input #1, linha Cells(w, 1).Value = linha w = w + 1 Wend Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="=", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Close #1 Columns("A:B").EntireColumn.AutoFit Range("A1").Select '-------Determina tamanho da nova base------- Dim tam As Integer Dim wsBase As Worksheet Set wsBase = Sheets("Base") tam = wsBase.Cells.SpecialCells(xlCellTypeLastCell).Row '--------Determina tamanho da lista desatualizada------- Dim wsSfpnew As Worksheet Set wsSfpnew = Sheets("SFP") Dim j As Long Dim l As Long Dim i As Long l = wsSfpnew.Cells.SpecialCells(xlCellTypeLastCell).Row i = l + 1 '---------Acrescenta dados-------- For j = 1 To tam With Worksheets("Base").Cells(j, "A") If InStr(.Value, "NE:") > 0 Then Sheets("SFP").Cells(l, "A") = .Value ElseIf InStr(.Value, "Board:") > 0 Then Sheets("SFP").Cells(l, "B") = .Value ElseIf InStr(.Value, "Main") > 0 Then Sheets("SFP").Cells(l, "C") = .Value ElseIf InStr(.Value, "Port") > 0 Then Sheets("SFP").Cells(l, "C") = .Value ElseIf InStr(.Value, "BoardType") > 0 Then Sheets("SFP").Cells(l, "D") = .Offset(0, 1).Value ElseIf InStr(.Value, "BarCode") > 0 Then Sheets("SFP").Cells(l, "E") = .Offset(0, 1).Value ElseIf InStr(.Value, "Item") > 0 Then Sheets("SFP").Cells(l, "F") = .Offset(0, 1).Value ElseIf InStr(.Value, "Description") > 0 Then Sheets("SFP").Cells(l, "G") = .Offset(0, 1).Value End If l = l + 1 End With Next j '---------Determina tamanho da lista atualizada--------- Dim tam2 As Long Dim wsSFP As Worksheet Set wsSFP = Sheets("SFP") tam2 = wsSFP.Cells.SpecialCells(xlCellTypeLastCell).Row Dim k As Long 'sms = MsgBox("Tam2 = " & tam2, vbOKOnly) 'sms = MsgBox("i = " & i, vbOKOnly) '---------Preenche espaços vazios das atualizações-------- For k = 1 To 2 With Worksheets("SFP") For j = i To tam2 Do While IsEmpty(Cells(j, k)) = True And IsEmpty(Cells(j - 1, k)) = False Cells(j - 1, k).Copy (Cells(j, k)) Loop Next j End With Next k Sheets("SFP").Select Columns("A:G").EntireColumn.AutoFit Application.ScreenUpdating = True End Sub
Agradeço muitíssimo a ajuda.
- Editado Fábio D. Medina quarta-feira, 5 de dezembro de 2012 16:10
Respostas
-
Então, o problema de executar parte do código eu resolvi, reescrevendo e pensando em outra logica para aquela parte. Não sei te dizer exatamente se é OpenText ou não, parte desse codigo foi feito com gravação de macro e especificamente esta parte que citou eu adaptei de um outro forum que achei na rede. Só sei te dizer que por algum motivo, sem essa parte, nenhuma das rotinas, seja a geradora, seja a que adiciona elementos funciona. Não importava sem essa parte.
Criei ponto de interrupção no meu código antes mesmo de abrir esta Thread, e como eu disse acima, a rotina simplesmente pulava certas linhas do codigo.
Enfim, agradeço a resposta.
Sub add() Application.ScreenUpdating = False '-------Deleta BASE antiga e abre nova--------- Sheets("Base").Delete Sheets.add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Select Sheets(Sheets.Count).Name = "Base" Dim linha As Variant Dim w As Long Dim arquivo As String arquivo = Application.GetOpenFilename("(*.txt),*.txt") Open arquivo For Input As #1 w = 1 While Not EOF(1) Line Input #1, linha Cells(w, 1).Value = linha w = w + 1 Wend Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="=", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Close #1 Columns("A:B").EntireColumn.AutoFit Range("A1").Select '-------Determina tamanho da nova base------- Dim tam As Integer Dim wsBase As Worksheet Set wsBase = Sheets("Base") tam = wsBase.Cells.SpecialCells(xlCellTypeLastCell).Row '--------Determina tamanho da lista desatualizada------- Dim wsSFP As Worksheet Set wsSFP = Worksheets("SFP") Dim j As Long Dim v As Long Dim i As Integer Dim n As Integer Dim LRow& With wsSFP Let LRow& = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row End With v = LRow& i = v + 1 n = i '---------Acrescenta dados-------- For j = 1 To tam With Worksheets("Base").Cells(j, "A") If InStr(.Value, "NE:") > 0 Then Sheets("SFP").Cells(i, "A") = .Value ElseIf InStr(.Value, "Board:") > 0 Then Sheets("SFP").Cells(i - 1, "B") = .Value ElseIf InStr(.Value, "Main") > 0 Then Sheets("SFP").Cells(i - 2, "C") = .Value ElseIf InStr(.Value, "Port") > 0 Then Sheets("SFP").Cells(i - 2, "C") = .Value ElseIf InStr(.Value, "BoardType") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 4, "C")) = True Then Sheets("SFP").Cells(i - 3, "D") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 4, "D") = .Offset(0, 1).Value End If ElseIf InStr(.Value, "BarCode") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 5, "C")) = True Then Sheets("SFP").Cells(i - 4, "E") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 5, "E") = .Offset(0, 1).Value End If ElseIf InStr(.Value, "Item") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 6, "C")) = True Then Sheets("SFP").Cells(i - 5, "F") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 6, "F") = .Offset(0, 1).Value End If ElseIf InStr(.Value, "Description") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 7, "C")) = True Then Sheets("SFP").Cells(i - 6, "G") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 7, "G") = .Offset(0, 1).Value End If End If i = i + 1 End With Next j '---------Determina tamanho da lista atualizada--------- Dim tam2 As Integer tam2 = wsSFP.Cells.SpecialCells(xlCellTypeLastCell).Row Dim k As Long '-------Deleta linhas brancas-------- With Worksheets("SFP") Do While tam2 <> n If IsEmpty(.Cells(tam2, 7)) = True Then .Rows(tam2).Delete tam2 = tam2 - 1 Else tam2 = tam2 - 1 End If Loop End With '---------Preenche espaços vazios das atualizações-------- Dim tam3 As Long Dim LR As Long With Worksheets("SFP") Let LR = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row End With tam3 = LR j = n + 1 For k = 1 To 2 With Worksheets("SFP") Do While j <= tam3 If IsEmpty(.Cells(j, k)) = True And IsEmpty(.Cells(j - 1, k)) = False Then .Cells(j - 1, k).Copy Destination:=.Cells(j, k) j = j + 1 Else j = j + 1 End If Loop End With j = n + 1 Next k '------------------FIM-------------------- Sheets("SFP").Select Columns("A:G").EntireColumn.AutoFit Application.ScreenUpdating = True End Sub
- Editado Fábio D. Medina segunda-feira, 10 de dezembro de 2012 15:18
- Marcado como Resposta Fábio D. Medina segunda-feira, 10 de dezembro de 2012 15:18
Todas as Respostas
-
*O correto é executar.
Tem algumas coisas em seu código que não estou entendendo. Por exemplo, para que serve o bloco de código abaixo?
Dim linha As Variant Dim w As Long Dim arquivo As String arquivo = Application.GetOpenFilename("(*.txt),*.txt") Open arquivo For Input As #1 w = 1 While Not EOF(1) Line Input #1, linha Cells(w, 1).Value = linha w = w + 1 Wend
Você está importando os dados através do método OpenText, não é necessária essa parte.
Desconfio que pelo fato de você estar usando o método Select (de planilha e célula) você está tendo estes problemas.
Crie pontos de interrupção com a tecla F9 em seu código para ver onde o código pára de executar.
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
- Sugerido como Resposta Hezequias VasconcelosModerator segunda-feira, 10 de dezembro de 2012 14:28
- Não Sugerido como Resposta Fábio D. Medina segunda-feira, 10 de dezembro de 2012 15:17
-
Então, o problema de executar parte do código eu resolvi, reescrevendo e pensando em outra logica para aquela parte. Não sei te dizer exatamente se é OpenText ou não, parte desse codigo foi feito com gravação de macro e especificamente esta parte que citou eu adaptei de um outro forum que achei na rede. Só sei te dizer que por algum motivo, sem essa parte, nenhuma das rotinas, seja a geradora, seja a que adiciona elementos funciona. Não importava sem essa parte.
Criei ponto de interrupção no meu código antes mesmo de abrir esta Thread, e como eu disse acima, a rotina simplesmente pulava certas linhas do codigo.
Enfim, agradeço a resposta.
Sub add() Application.ScreenUpdating = False '-------Deleta BASE antiga e abre nova--------- Sheets("Base").Delete Sheets.add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Select Sheets(Sheets.Count).Name = "Base" Dim linha As Variant Dim w As Long Dim arquivo As String arquivo = Application.GetOpenFilename("(*.txt),*.txt") Open arquivo For Input As #1 w = 1 While Not EOF(1) Line Input #1, linha Cells(w, 1).Value = linha w = w + 1 Wend Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="=", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True Close #1 Columns("A:B").EntireColumn.AutoFit Range("A1").Select '-------Determina tamanho da nova base------- Dim tam As Integer Dim wsBase As Worksheet Set wsBase = Sheets("Base") tam = wsBase.Cells.SpecialCells(xlCellTypeLastCell).Row '--------Determina tamanho da lista desatualizada------- Dim wsSFP As Worksheet Set wsSFP = Worksheets("SFP") Dim j As Long Dim v As Long Dim i As Integer Dim n As Integer Dim LRow& With wsSFP Let LRow& = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row End With v = LRow& i = v + 1 n = i '---------Acrescenta dados-------- For j = 1 To tam With Worksheets("Base").Cells(j, "A") If InStr(.Value, "NE:") > 0 Then Sheets("SFP").Cells(i, "A") = .Value ElseIf InStr(.Value, "Board:") > 0 Then Sheets("SFP").Cells(i - 1, "B") = .Value ElseIf InStr(.Value, "Main") > 0 Then Sheets("SFP").Cells(i - 2, "C") = .Value ElseIf InStr(.Value, "Port") > 0 Then Sheets("SFP").Cells(i - 2, "C") = .Value ElseIf InStr(.Value, "BoardType") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 4, "C")) = True Then Sheets("SFP").Cells(i - 3, "D") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 4, "D") = .Offset(0, 1).Value End If ElseIf InStr(.Value, "BarCode") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 5, "C")) = True Then Sheets("SFP").Cells(i - 4, "E") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 5, "E") = .Offset(0, 1).Value End If ElseIf InStr(.Value, "Item") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 6, "C")) = True Then Sheets("SFP").Cells(i - 5, "F") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 6, "F") = .Offset(0, 1).Value End If ElseIf InStr(.Value, "Description") > 0 Then If IsEmpty(Sheets("SFP").Cells(i - 7, "C")) = True Then Sheets("SFP").Cells(i - 6, "G") = .Offset(0, 1).Value Else Sheets("SFP").Cells(i - 7, "G") = .Offset(0, 1).Value End If End If i = i + 1 End With Next j '---------Determina tamanho da lista atualizada--------- Dim tam2 As Integer tam2 = wsSFP.Cells.SpecialCells(xlCellTypeLastCell).Row Dim k As Long '-------Deleta linhas brancas-------- With Worksheets("SFP") Do While tam2 <> n If IsEmpty(.Cells(tam2, 7)) = True Then .Rows(tam2).Delete tam2 = tam2 - 1 Else tam2 = tam2 - 1 End If Loop End With '---------Preenche espaços vazios das atualizações-------- Dim tam3 As Long Dim LR As Long With Worksheets("SFP") Let LR = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row End With tam3 = LR j = n + 1 For k = 1 To 2 With Worksheets("SFP") Do While j <= tam3 If IsEmpty(.Cells(j, k)) = True And IsEmpty(.Cells(j - 1, k)) = False Then .Cells(j - 1, k).Copy Destination:=.Cells(j, k) j = j + 1 Else j = j + 1 End If Loop End With j = n + 1 Next k '------------------FIM-------------------- Sheets("SFP").Select Columns("A:G").EntireColumn.AutoFit Application.ScreenUpdating = True End Sub
- Editado Fábio D. Medina segunda-feira, 10 de dezembro de 2012 15:18
- Marcado como Resposta Fábio D. Medina segunda-feira, 10 de dezembro de 2012 15:18
-