Delimitador TAB

Hola nuevamente!...
Ahora en mi TXT tengo esto:
GENERAL LENG    2    2010    1    3    11    2    B    31    NULL    
NULL    0,00    0,00    0,00    0,00    0,00    14,29    0,00    0,00    0,00    0,00    
0,00    0,00    0,00    0,00    0,00    0,00
GENERAL LENG    2    2010    1    3    11    2    B    32    NULL    
NULL    0,00    0,00    0,00    0,00    33.33    0,00    0,00    0,00    0,00    0,00    
0,00    0,00    0,00    0,00    0,00    0,00
GENERAL LENG    2    2010    1    3    11    2    B    33    NULL    
NULL    0,00    0,00    0,00    8,11    0,00    0,00    0,00    0,00    0,00    0,00    
0,00    0,00    0,00    0,00    0,00    0,00
Prioritarios GENERAL LENG 23    23,5
Entonces, qué tipo de datos en mis variables tengo que usar , para que queden igual en mi planilla Excel?
long, double?
Dim sUltimaHoja As String
Dim CntFilas As Integer
Sub Llenar()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim sRuta As String
    Dim sLinea As String
    Dim sHoja() As String
    sRuta = ActiveWorkbook.Path
    Set archivo = fso.OpenTextFile(sRuta + "/datostab.txt", 1)
    Do While Not archivo.AtEndOfStream
        sLinea = archivo.readline()
        sHoja = Split(sLinea, " ")
        If UCase(sUltimaHoja) <> UCase(sHoja(0)) Then
            If Trim(sUltimaHoja) <> "" Then
                For i = 1 To 8
                    Suma CntFilas + 1, i, 2
                Next
            End If
            sUltimaHoja = sHoja(0)
            CntFilas = 4
        Else
            CntFilas = CntFilas + 1
        End If
        If Not SheetExist(sUltimaHoja) Then
            Sheets.Add
            ActiveSheet.Name = sUltimaHoja
        End If
        LlenaLinea sUltimaHoja, sLinea, CntFilas
    Loop
    'Para la última hoja
    For i = 1 To 8
        Suma CntFilas + 1, i, 2
    Next
    archivo.Close
    MsgBox "Importado"
End Sub
Sub LlenaLinea(ByVal sHoja As String, ByVal sLinea As String, ByVal nFila As Double)
    Dim columna As Double
    columna = 1
    Sheets(sHoja).Select
    b = Split(sLinea, ",")
    For i = 1 To UBound(b)
        Cells(nFila, columna + i) = b(i)
        Cells(nFila, columna + i).Interior.ColorIndex = 6
        Cells(nFila, columna + i) = b(i)
      'Para diseñar celdas
        Dim vaColumna As Integer
        vaColumna = columna + i
           Range(Cells(4, 2), Cells(nFila, vaColumna)).Select
               Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
'        .LineStyle = xlContinuous
        .Weight = xlThin
'        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
'        .LineStyle = xlContinuous
        .Weight = xlThin
'        .ColorIndex = xlAutomatic
    End With
    Next
End Sub
Sub Suma(ByVal fila As Integer, ByVal columna As Integer, ByVal i As Integer)
    aa = NumeroALetra(columna + 1)
    aaa = Str(4)
    bbb = "=SUM(" & aa & aaa &...

1 respuesta

Respuesta
1
Lo único que cambia es en la función split, porque ahora el caracter separador de columnas es una tabulación
Dim sUltimaHoja As String 
Dim CntFilas As Integer 
Sub Llenar() 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Dim sRuta As String 
    Dim sLinea As String 
    Dim sHoja() As String 
    sRuta = ActiveWorkbook.Path 
    Set archivo = fso.OpenTextFile(sRuta + "/datostab.txt", 1) 
    Do While Not archivo.AtEndOfStream 
        sLinea = archivo.readline() 
        sHoja = Split(sLinea, vbTab) 
        If UCase(sUltimaHoja) <> UCase(sHoja(0)) Then 
            If Trim(sUltimaHoja) <> "" Then 
                For i = 1 To 8 
                    Suma CntFilas + 1, i, 2 
                Next 
            End If 
            sUltimaHoja = sHoja(0) 
            CntFilas = 4 
        Else 
            CntFilas = CntFilas + 1 
        End If 
        If Not SheetExist(sUltimaHoja) Then 
            Sheets.Add 
            ActiveSheet.Name = sUltimaHoja 
        End If 
        LlenaLinea sUltimaHoja, sLinea, CntFilas 
    Loop 
    'Para la última hoja 
    For i = 1 To 8 
        Suma CntFilas + 1, i, 2 
    Next 
    archivo.Close 
    MsgBox "Importado" 
End Sub 
Sub LlenaLinea(ByVal sHoja As String, ByVal sLinea As String, ByVal nFila As Double) 
    Dim columna As Double 
    columna = 1 
    Sheets(sHoja).Select 
    b = Split(sLinea, vbTab) 
    For i = 1 To UBound(b) 
        Cells(nFila, columna + i) = b(i) 
        Cells(nFila, columna + i).Interior.ColorIndex = 6 
        Cells(nFila, columna + i) = b(i) 
      'Para diseñar celdas 
        Dim vaColumna As Integer 
        vaColumna = columna + i 
           Range(Cells(4, 2), Cells(nFila, vaColumna)).Select 
               Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .Weight = xlThin 
        .ColorIndex = xlAutomatic 
    End With 
    With Selection.Borders(xlInsideVertical) 
'        .LineStyle = xlContinuous 
        .Weight = xlThin 
'        .ColorIndex = xlAutomatic 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
'        .LineStyle = xlContinuous 
        .Weight = xlThin 
'        .ColorIndex = xlAutomatic 
    End With 
    Next 
End Sub 
Sub Suma(ByVal fila As Integer, ByVal columna As Integer, ByVal i As Integer) 
    aa = NumeroALetra(columna + 1) 
    aaa = Str(4) 
    bbb = "=SUM(" & aa & aaa & ":" & aa & Str(fila - 1) & ")" 
    bbb = Replace(bbb, " ", "") 
    Cells(fila, columna + 1) = bbb 
    Cells(fila, columna + 1).Interior.ColorIndex = 15 
End Sub 
Function SheetExist(ByVal sSheetName As String) As Boolean 
    Dim sHoja As Worksheet 
    SheetExist = False 
    For Each sHoja In ActiveWorkbook.Worksheets 
        If UCase(sHoja.Name) = UCase(sSheetName) Then 
            SheetExist = True 
            Exit For 
        End If 
    Next 
End Function 
Function NumeroALetra(ByVal Numeri As Integer) As String 
    Select Case Numeri 
        Case 1 
            NumeroALetra = "A" 
        Case 2 
            NumeroALetra = "B" 
        Case 3 
            NumeroALetra = "C" 
        Case 4 
            NumeroALetra = "D" 
        Case 5 
            NumeroALetra = "E" 
        Case 6 
            NumeroALetra = "F" 
        Case 7 
            NumeroALetra = "G" 
        Case 8 
            NumeroALetra = "H" 
        Case 9 
            NumeroALetra = "I" 
        Case 10 
            NumeroALetra = "J" 
            'etc.... 
    End Select 
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas