| 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... |
| | Trabalhando com String importada do .TXT | |
| | Autor | Mensagem |
---|
JoaoCampelo
Mensagens : 17 Data de inscrição : 04/02/2013
| Assunto: 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! | |
| | | alexandrevba
Mensagens : 1820 Data de inscrição : 13/07/2011 Localização : Serra - ES
| Assunto: 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 | |
| | | JoaoCampelo
Mensagens : 17 Data de inscrição : 04/02/2013
| Assunto: 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! | |
| | | JoaoCampelo
Mensagens : 17 Data de inscrição : 04/02/2013
| Assunto: Resolvido Qua Fev 06, 2013 1:20 pm | |
| | |
| | | JoaoCampelo
Mensagens : 17 Data de inscrição : 04/02/2013
| Assunto: 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] | |
| | | Conteúdo patrocinado
| Assunto: Re: Trabalhando com String importada do .TXT | |
| |
| | | | Trabalhando com String importada do .TXT | |
|
Tópicos semelhantes | |
|
| Permissões neste sub-fórum | Não podes responder a tópicos
| |
| |
| |
|