Visual Basic - Importar de txt a Excel

Life is soft - evento anual de software empresarial
 
Vista:

Importar de txt a Excel

Publicado por David Lezcano (4 intervenciones) el 30/03/2009 21:49:03
Hola Amigos,
queria pedirles una favor urgente, les comento, tengo un archivo txt, y quiero exportar los campos a excel, encontre una macro antigua de un amigo, he modificado algunos parametros pero algo esta mal y ya quede trabado

como deberia quedar en Excel
REG 1 TSC_1 FLEN_1 ITOH_1 RRPA_1 RLI_1 CCBA_1
0 0 0 0 0 0 0

archivo fuente en txt ( de estos campos son como 500 registros )

TSC 1777
FLEN 4
ITOH NO
RRPA NO
RLI 300
CCBA NO

TSC 31157
FLEN 5
ITOH NO
RRPA NO
RLI 101
CCBA NO

TSC 31167
FLEN 5
ITOH NO
RRPA NO
RLI 106
CCBA NO

TSC 31169
FLEN 5
ITOH NO
RRPA NO
RLI 104
CCBA NO


Este es la macro que encontre e intente cambiar sin exito

Sub Leer_archivo()

Dim xMatriz_TSC(10)
Dim xMatriz_FLEN(55)
Dim xMatriz_ITOH(45)
Dim xMatriz_RRPA(5)
Dim xMatriz_RLI(8)
Dim xMatriz_CCBA(8)

'***** Nombre del archivo Fuente **************
xarchivo = "D:29mar09.txt"

Open xarchivo For Input Access Read As #1
xInicia_Recoleccion = False

Do While Not EOF(1)
'Line Input #1, xregistro
'xregistro = Trim(xregistro)
'If Mid(xregistro, 1, 6) = "TIM597" And Mid(xregistro, 11, 2) = "00" Then
'If Mid(xregistro, 1, 3) = "TSC" Then
'xVariable_1 = xregistro
'xInicia_Recoleccion = True
'End If
If xInicia_Recoleccion = True Then
Do While xInicia_Recoleccion = True
Line Input #1, xregistro
xregistro = Trim(xregistro)
If xregistro = "MSDL AML: 10" Then
xVariable_2 = xregistro
Do While Mid(Trim(xregistro), 1, 4) <> "CCBA"
Line Input #1, xregistro
xregistro = Trim(xregistro)
Select Case Trim(Mid(xregistro, 1, 3))
Case "TSC"
xMatriz_TSC(1) = Mid(xregistro, 6, 5)
Case "FLEN"
xMatriz_FLEN(1) = Mid(xregistro, 6, 1)
Case "ITOH"
xMatriz_ITOH(1) = Mid(xregistro, 6, 2)
Case "RRPA"
xMatriz_RRPA(1) = Mid(xregistro, 6, 2)
Case "RLI"
xMatriz_RLI(1) = Mid(xregistro, 6, 5)
'Case "CCBA"
'xMatriz_CCBA(1) = Mid(xregistro, 6, 5)

End Select
Loop
xMatriz_CCBA(1) = Mid(xregistro, 6, 5)
'xMatriz_CCBA(1) = Mid(xregistro, 6, 5)
'xMatriz_PKTS(1) = Mid(xregistro, 8, 5)
'xMatriz_PKTS(2) = Mid(xregistro, 15, 5)
Worksheets("REGISTRO").Activate
Worksheets("REGISTRO").Range("A1").Select
Selection.End(xlDown).Select
xpos = Mid(Trim(ActiveCell.Address), 1, 3) + Trim(Str(ActiveCell.Row + 1))
Range(xpos).Select
ActiveCell.Value = xVariable_1

Worksheets("REGISTRO").Range("A1").Select
For xVar = 1 To 5
Cells.Find(What:="TSC_" + Trim(Str(xVar)), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True).Activate
Selection.End(xlDown).Select
xpos = Mid(Trim(ActiveCell.Address), 1, 3) + Trim(Str(ActiveCell.Row + 1))
Range(xpos).Select
ActiveCell.Value = xMatriz_TSC(xVar)
Next
For xVar = 1 To 51
Cells.Find(What:="FLEN_" + Trim(Str(xVar)), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True).Activate
Selection.End(xlDown).Select
xpos = Mid(Trim(ActiveCell.Address), 1, 3) + Trim(Str(ActiveCell.Row + 1))
Range(xpos).Select
ActiveCell.Value = xMatriz_FLEN(xVar)
Next
For xVar = 1 To 40
Cells.Find(What:="ITOH_" + Trim(Str(xVar)), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True).Activate
Selection.End(xlDown).Select
xpos = Mid(Trim(ActiveCell.Address), 1, 3) + Trim(Str(ActiveCell.Row + 1))
Range(xpos).Select
ActiveCell.Value = xMatriz_ITOH(xVar)
Next
For xVar = 1 To 4
Cells.Find(What:="RRPA_" + Trim(Str(xVar)), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True).Activate
Selection.End(xlDown).Select
xpos = Mid(Trim(ActiveCell.Address), 1, 3) + Trim(Str(ActiveCell.Row + 1))
Range(xpos).Select
ActiveCell.Value = xMatriz_RRPA(xVar)
Next
For xVar = 1 To 5
Cells.Find(What:="RLI_" + Trim(Str(xVar)), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True).Activate
Selection.End(xlDown).Select
xpos = Mid(Trim(ActiveCell.Address), 1, 3) + Trim(Str(ActiveCell.Row + 1))
Range(xpos).Select
ActiveCell.Value = xMatriz_RLI(xVar)
Next
For xVar = 1 To 6
Cells.Find(What:="CCBA_" + Trim(Str(xVar)), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True).Activate
Selection.End(xlDown).Select
xpos = Mid(Trim(ActiveCell.Address), 1, 3) + Trim(Str(ActiveCell.Row + 1))
Range(xpos).Select
ActiveCell.Value = xMatriz_CCBA(xVar)

Next
xInicia_Recoleccion = False
End If
Loop
End If

Loop

Close #1

End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Importar de txt a Excel

Publicado por David LEzcano (4 intervenciones) el 02/04/2009 19:01:48
ayuda urgente pelase
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Importar de txt a Excel

Publicado por Jesus (22 intervenciones) el 08/04/2009 17:30:03
hola

Lo siguiente lo encontre en foros del web

Private objExcel As Object
Private Sub Timer1_Timer()
Label1.Caption = objExcel.Worksheets("Hoja1").Range("A1")
End Sub
Private Sub Command1_Click()
Dim objExcel As Excel.Application
Dim xLibro As Excel.Workbook
Dim Col As Integer, Fila As Integer
Set objExcel = New Excel.Application
Set xLibro = objExcel.Workbooks.Open("C:hoja.xls")
objExcel.Visible = True
With xLibro
With .Sheets(1)
Fila = 1
Label1.Caption = cells(Fila, 2)
Fila = 2
cells(Fila, 2) = Text1.Text
End With
End With
Set objExcel = Nothing
Set xLibro = Nothing
End Sub

Espero que te sirva.
Un saludo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar