Fórum Excel Bácico, Avançado e Vba
Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.
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  Últimas imagensÚltimas imagens  ProcurarProcurar  RegistarRegistar  Entrar  

 

 Trabalhando com String importada do .TXT

Ir para baixo 
2 participantes
AutorMensagem
JoaoCampelo




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

Trabalhando com String importada do .TXT Empty
MensagemAssunto: Trabalhando com String importada do .TXT   Trabalhando com String importada do .TXT EmptySeg 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!
Ir para o topo Ir para baixo
alexandrevba

alexandrevba


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

Trabalhando com String importada do .TXT Empty
MensagemAssunto: Re: Trabalhando com String importada do .TXT   Trabalhando com String importada do .TXT EmptyTer 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
Ir para o topo Ir para baixo
JoaoCampelo




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

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

Nossa, valeu mesmo pela ajuda, acho que não soube filtrar minha procura!
Ir para o topo Ir para baixo
JoaoCampelo




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

Trabalhando com String importada do .TXT Empty
MensagemAssunto: Resolvido   Trabalhando com String importada do .TXT EmptyQua Fev 06, 2013 1:20 pm

Resolvido!
Ir para o topo Ir para baixo
JoaoCampelo




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

Trabalhando com String importada do .TXT Empty
MensagemAssunto: Resolvido   Trabalhando com String importada do .TXT EmptySex 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]
Ir para o topo Ir para baixo
Conteúdo patrocinado





Trabalhando com String importada do .TXT Empty
MensagemAssunto: Re: Trabalhando com String importada do .TXT   Trabalhando com String importada do .TXT Empty

Ir para o topo Ir para baixo
 
Trabalhando com String importada do .TXT
Ir para o topo 
Página 1 de 1
 Tópicos semelhantes
-
» Manipular String com VBA
» Dúvida Gráficos Fonte de Dados Texto (String)

Permissões neste sub-fórumNão podes responder a tópicos
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: