Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

 Trabalhando com String importada do .TXT

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
JoaoCampelo



Mensagens : 17
Data de inscrição : 04/02/2013

MensagemAssunto: Trabalhando com String importada do .TXT   Seg Fev 04, 2013 11:15 pm

Boa tarde,

Tenho uma rotina autolisp que envia relação de materiais para um bloco de notas, criando o bloco e o salvando com o nome LISTA - nome.dwg menos o .dwg.
Exemplo TXT:
Tubo de PVC rígido soldável Marrom (barra 6m) - 20mm A.F.
2 Tubo de PVC rígido soldável Marrom (barra 6m) - 20mm A.F.
1 Tubo de PVC rígido soldável Marrom (barra 6m) - 110mm A.F.
2 Tubo de FG NBR 5680 / 5590 / DIN 2240 - 1/2" INC
1 Tubo de PVC (NBR 5688) com ponta / bolsa - 6 metros - 100mm E.S. E A.P.
Eu encontrei uma macro pronta em vba que importa essas linhas, eu estou tentando adaptá-la para quando rodar a macro na planilha modelo, crie uma nova planilha com o nome: LISTA - nometxt(-.txt).xls, tenho também que separar esse planilha em sheets de acordo com o código que termina a frase importada do txt, exemplo: INC E.S. E A.P. A.F. A.Q. - só esses 4 e colocar essa relação separando o texto assim: TEXTO(sem número índice e sem a sigla que denomina a sheet)|QUANTIDADE(número índice)
Estou tendo problema em manipular a string, meu código ficou assim:


Contador = 0
Dim Z As Integer
Dim oApp As Excel.Application
Dim oWks As Excel.Workbook
Dim filename As Variant
Dim quant As Variant
Dim Celula As Variant
Dim Colunasb As Range
Dim Colunasc As Range
Dim Colunasd As Range
Dim aux1 As String
Dim aux2 As String
Dim ca As String
Dim cb As String



'Contador de linhas
I = 2
'abre um "mini" explorer de arquivos
Arquivo = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")
'retorna o nome do arquivo aberto
filename = Application.GetOpenFilename(, , "Select Programme")
filename = Mid(filename, InStrRev(filename, "\") + 1)
'abre o arquivo texto
Open Arquivo For Input As #1



'Novo arquivo excel
Set oApp = New Excel.Application
Set oWks = oApp.Workbooks.Add
oWks.SaveAs "C:\Autodesk\AutoCAD_2012_English_Win_64bit\Minhas Rotinas\filename.xls"
ActiveSheet.Name = "Plan1"
Worksheets("Plan1").Activate
Sheets.Add
ActiveSheet.Name = "INC"
Sheets("INC").Move After:=Sheets("Plan1")
Sheets.Add
ActiveSheet.Name = "E.S. E A.P."
Sheets("E.S E A.P.").Move After:=Sheets("INC")
Sheets.Add
ActiveSheet.Name = "A.F."
Sheets("A.F.").Move After:=Sheets("E.S. E A.P.")
Sheets.Add
ActiveSheet.Name = "A.Q."
Sheets("A.Q.").Move After:=Sheets("A.F.")
'Trabalhando na sheet plan1

Set Colunasb = Range("B1:B20000")
Set Colunasc = Range("C1:C20000")
Set Colunasd = Range("D1:D20000")
Set Colunase = Range("E1:E20000")

'Enquanto não chega ao fim do arquivo texto
While Not (EOF(1))
'Captura 1 linha e armazena na variável Linha
Line Input #1, linha
'separa os campos e armazena na variável "Campos"
Campos = Split(linha, "")
'Distribui os campos na planilha
For j = 0 To UBound(Campos)
Cell(I, j + 1).Value = Campos(j)
Next
'incrementa uma linha
I = I + 1
Wend
'fecha o arquivo texto
Close #1

For I = 2 To UBound(Campos)
ca = Cell(AI).Value
cb = Cell(BI).Value
aux1 = InStr(ca, "Tubo", 1)
quantidade = Left(ca, (aux1 - 2))
aux2 = InStr(ca, "mm", 1)
tamanho = Len(ca)
layer = Right(ca, ((tamanho - aux2) + 1))
cb = quantidade



End Sub


Mas não está compilando, tive VB há muitos anos na faculdade e estou bem enferrujado, se alguém puder me ajudar! Obrigado!
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Trabalhando com String importada do .TXT   Ter Fev 05, 2013 11:10 pm

Boa noite!!

Já foi respondido em:
http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=7011

Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
JoaoCampelo



Mensagens : 17
Data de inscrição : 04/02/2013

MensagemAssunto: Re: Trabalhando com String importada do .TXT   Qua Fev 06, 2013 12:55 pm

Nossa, valeu mesmo pela ajuda, acho que não soube filtrar minha procura!
Voltar ao Topo Ir em baixo
Ver perfil do usuário
JoaoCampelo



Mensagens : 17
Data de inscrição : 04/02/2013

MensagemAssunto: Resolvido   Qua Fev 06, 2013 1:20 pm

Resolvido!
Voltar ao Topo Ir em baixo
Ver perfil do usuário
JoaoCampelo



Mensagens : 17
Data de inscrição : 04/02/2013

MensagemAssunto: Resolvido   Sex Fev 15, 2013 3:22 pm

O código limpo ficou assim, agradecendo a ajuda de Alexandrevba:

Option Explicit
Private Sub ImportarTXTListaMaterial_Click()
Dim Campos As Variant
Dim Arquivotxt, Arquivoxls, layermm, auxiliar As String
Dim layeraspas, linha, ca, cb, cc As String
Dim strNome, strName, var1, var2, sPath, auxfilename, aspas As String
Dim i, j, K, a, tamanho, comsPath, comArquivotxt, comauxfilename, aux1, aux2, aux3 As Long
Dim lin, quantidade, intErro, l, auxiliar1, arra(240), contresp As Integer
Dim oApp As Excel.Application
Dim oWks As Excel.Workbook
Dim INC, ESEAP, AF, AQ, Plan1, Plan2 As Excel.Worksheet
Dim wsOrigem As Worksheet
Dim wsDestino As Worksheet
Dim filename As Variant
'Nome do responsável - Caixa de Diálogo Windows
strNome = InputBox(Prompt:="Informe nome do Responsável (Altair/Pedro/Ambos): ", _
Title:="QUAL O SEU NOME")
'se não informou nada e cancelou então sai
If strNome = "seu nome" Or strNome = vbNullString Then
Exit Sub
Else
Select Case strNome
Case "Altair"
contresp = 0

Case "Pedro"
contresp = 1
Case "Ambos"
contresp = 2
Case Else
intErro = MsgBox(Prompt:="Nome do responsável incorreto!", _
Buttons:=0)
Exit Sub
End Select
End If
'abre um "mini" explorer de arquivos
Arquivotxt = Application.GetOpenFilename("Arquivos Texto(*.txt), *.txt")
'abre o arquivo texto
Open Arquivotxt For Input As #1

K = 2
'Enquanto não chega ao fim do arquivo texto
While Not (EOF(1))
'Captura 1 linha e armazena na variável Linha
Line Input #1, linha
'separa os campos e armazena na variável "Campos"
Campos = Split(linha, ";")
'Distribui os campos na planilha
Dim Palavras(1) As String
For j = 0 To UBound(Campos)
Sheets("Plan3").Cells(K, j + 1).Value = Campos(j)
Next
'incrementa uma linha
K = K + 1
Wend
'fecha o arquivo texto
Close #1
'Manipulando strings para criar e salvar novo arquivo .xls com mesmo nome e na mesma pasta do .txt
comArquivotxt = Len(Arquivotxt)
sPath = Left(Arquivotxt, ((InStr(1, Arquivotxt, "LISTA-", 1)) - 1))
comsPath = Len(sPath)
auxfilename = Right(Arquivotxt, (comArquivotxt - comsPath))
comauxfilename = Len(auxfilename)
filename = Left(auxfilename, (comauxfilename - 4))
'Novo arquivo excel
'Set oApp = New Excel.Application
Set oWks = Workbooks.Add
Worksheets("Plan1").Activate
'Salva Excel Criado
oWks.SaveAs "C:\Autodesk\AutoCAD_2012_English_Win_64bit\Minhas Rotinas\" & filename & ".xls"
Arquivoxls = sPath & filename & ".xls"
'Arquivos e Abas de Origem e Destino
Set wsOrigem = Workbooks("Lista_De_Material_Modelo").Worksheets("Plan3")
Set wsDestino = Worksheets("Plan1")
With wsOrigem
.Range("A2:A20000").Copy Destination:=wsDestino.Range("A2:A20000")
.Range("A2:A20000").Delete
End With
'Copia Modelos para a nova Pasta de Trabalho
'Teste Responsável
Select Case contresp
Case 0
ThisWorkbook.Sheets("INC0").Copy Before:=oWks.Sheets(1)
ThisWorkbook.Sheets("E.S. E A.P.0").Copy After:=oWks.Sheets("INC0")
ThisWorkbook.Sheets("A.F.0").Copy After:=oWks.Sheets("E.S. E A.P.0")
ThisWorkbook.Sheets("A.Q.0").Copy After:=oWks.Sheets("A.F.0")
'Renomear Sheets
Sheets("INC0").Name = "INC"
Sheets("E.S. E A.P.0").Name = "E.S. E A.P."
Sheets("A.F.0").Name = "A.F."
Sheets("A.Q.0").Name = "A.Q."

Case 1
ThisWorkbook.Sheets("INC1").Copy Before:=oWks.Sheets(1)
ThisWorkbook.Sheets("E.S. E A.P.1").Copy After:=oWks.Sheets("INC1")
ThisWorkbook.Sheets("A.F.1").Copy After:=oWks.Sheets("E.S. E A.P.1")
ThisWorkbook.Sheets("A.Q.1").Copy After:=oWks.Sheets("A.F.1")
'Renomear Sheets
Sheets("INC1").Name = "INC"
Sheets("E.S. E A.P.1").Name = "E.S. E A.P."
Sheets("A.F.1").Name = "A.F."
Sheets("A.Q.1").Name = "A.Q."
Case 2
ThisWorkbook.Sheets("INC2").Copy Before:=oWks.Sheets(1)
ThisWorkbook.Sheets("E.S. E A.P.2").Copy After:=oWks.Sheets("INC2")
ThisWorkbook.Sheets("A.F.2").Copy After:=oWks.Sheets("E.S. E A.P.2")
ThisWorkbook.Sheets("A.Q.2").Copy After:=oWks.Sheets("A.F.2")
'Renomear Sheets
Sheets("INC2").Name = "INC"
Sheets("E.S. E A.P.2").Name = "E.S. E A.P."
Sheets("A.F.2").Name = "A.F."
Sheets("A.Q.2").Name = "A.Q."
End Select


'ThisWorkbook.Close SaveChanges:=True
'Cerne do programa lê cada linha importada do txt e adiciona quantidade na tabela
For l = 2 To 20000
If Sheets("Plan1").Cells(l, 1).Text = "" Then
intErro = MsgBox(Prompt:="Lista de Material Finalizada!", _
Buttons:=0)
Exit Sub
Else
ca = wsDestino.Cells(l, 1)
aux1 = InStr(1, ca, "Tubo", 1)
quantidade = CInt(Left(ca, (aux1 - 2)))
aux2 = InStr(1, ca, "mm", 1)
aspas = CStr(Chr(34))
aux3 = InStr(1, ca, aspas, 1)
tamanho = CInt(Len(ca))
layermm = Right(ca, ((tamanho - aux2) - 2))
layeraspas = Right(ca, ((tamanho - aux3) - 1))
If aux3 = 0 Then
cb = Mid(ca, aux1, (aux2 - 1))
Else
cc = Mid(ca, aux1, (aux3 - 1))
End If
If layeraspas = "INC" Then
i = 1
j = 182
For i = 1 To 9
auxiliar = Sheets("INC").Cells(j, 2)
auxiliar1 = StrComp(cc, auxiliar, 1)
If auxiliar1 = 0 Then
Sheets("INC").Cells(j, 5).Value = arra(j) + quantidade
arra(j) = Sheets("INC").Cells(j, 5).Value
End If
j = j + 1
Next
ElseIf layermm = "E.S. E A.P." Then
i = 10
j = 102
For i = 10 To 14
auxiliar = Sheets("E.S. E A.P.").Cells(j, 2)
auxiliar1 = StrComp(cb, auxiliar, 1)
If auxiliar1 = 0 Then
Sheets("E.S. E A.P.").Cells(j, 5).Value = arra(j) + quantidade
arra(j) = Sheets("E.S. E A.P.").Cells(j, 5).Value
End If
j = j + 1
Next
ElseIf layermm = "A.F." Then
Sheets("A.F.").Activate
i = 15
j = 196
For i = 15 To 23
auxiliar = Sheets("A.F.").Cells(j, 2)
auxiliar1 = StrComp(cb, auxiliar, 1)
If auxiliar1 = 0 Then
Sheets("A.F.").Cells(j, 5).Value = arra(j) + quantidade
arra(j) = Sheets("A.F.").Cells(j, 5).Value
End If
j = j + 1
Next
ElseIf layermm = "A.Q." Then
i = 24
j = 231
For i = 24 To 32
auxiliar = Sheets("A.Q.").Cells(j, 2)
auxiliar1 = StrComp(cb, auxiliar, 1)
If auxiliar1 = 0 Then
Sheets("A.Q.").Cells(j, 5).Value = arra(j) + quantidade
arra(j) = Sheets("A.Q.").Cells(j, 5).Value
End If
j = j + 1
Next
End If
End If
Next
End Sub[code]
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Conteúdo patrocinado




MensagemAssunto: Re: Trabalhando com String importada do .TXT   Hoje à(s) 2:52 am

Voltar ao Topo Ir em baixo
 
Trabalhando com String importada do .TXT
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» String de tamanho limitado
» Substituir string por outra
» [Duvida] Transformar string em numero real
» colorir string _ me ajuda e simples
» Retirar a ultima letra adicionada em uma string!

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: