Pasar TXT con decimales comas a XLS
Hola,
Necesito copiar un txt con valores en decimales comas (,). En mi código se copian, pero en la planilla me advierte que la celda tiene formato de texto, siendo que son números. Podrías solucionarlo?
datostab.txt:
GENERAL LENG 2 2010 1 3 11,8 2 8 31
GENERAL LENG 2 2010 1 3 11,6 2 8 NULL
GENERAL LENG 2 2010 1 3 11,7 2 8 33
Prioritarios GENERAL LENG 23 23,5 43,6 5,5 23,5 2,5 11,5 1
Prioritarios GENERAL LENG NULL 11 1,5 2,5 12,5 23,4 3,5 2,4
Macro:
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 Double, ByVal columna As Double, ByVal i As Double)
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...
Necesito copiar un txt con valores en decimales comas (,). En mi código se copian, pero en la planilla me advierte que la celda tiene formato de texto, siendo que son números. Podrías solucionarlo?
datostab.txt:
GENERAL LENG 2 2010 1 3 11,8 2 8 31
GENERAL LENG 2 2010 1 3 11,6 2 8 NULL
GENERAL LENG 2 2010 1 3 11,7 2 8 33
Prioritarios GENERAL LENG 23 23,5 43,6 5,5 23,5 2,5 11,5 1
Prioritarios GENERAL LENG NULL 11 1,5 2,5 12,5 23,4 3,5 2,4
Macro:
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 Double, ByVal columna As Double, ByVal i As Double)
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...
1 Respuesta
Respuesta de Victor Perdomo
1