Function LeerDatoMATRIZ(Colum As Long, Fila As Long, RutaArchivo As String) As Variant
'Lee datos de una cadena separada por comas.. ejemplo:
' xxxxx, xxxxx, xxxxx , xxxxx, etc...
Dim NumLine As Long
Dim Cadena1 As String
Dim Cadena As String
Dim Dato As Variant
If Dir(RutaArchivo) = "" Then 'Comprueba si existe archivo, en caso de no existir, lo crea.
Open RutaArchivo For Output As #1
Print #1, "Archivo de Texto creado para guardar información" & vbCrLf & "jimbenit@hotmail.com"
Close #1
End If
Open RutaArchivo For Input As #1 'Copia la fila completa en la variable cadena
While Not EOF(1)
Line Input #1, Cadena1
NumLine = NumLine + 1
If NumLine = Fila Then
Cadena = Cadena1
End If
Wend
Close #1
Dim NumLet As Long
Dim Cont As Long
Dim Letr As String
Dim PosComas() As Long
Dim NumCarac As Long
NumLet = Len(Cadena)
For i = 1 To NumLet 'Cuenta las comas dentro de la cadena
Letr = Mid(Cadena, i, 1)
If Asc(Letr) = 44 Then
Cont = Cont + 1
End If
Next i
If Colum > Cont + 1 Then Exit Function 'Columna vacia
ReDim PosComas(Cont)
Cont = 0
For i = 1 To NumLet 'Coloca las posiciones de las comas dentro del vector
Letr = Mid(Cadena, i, 1)
If Asc(Letr) = 44 Then
Cont = Cont + 1
PosComas(Cont) = i
End If
Next i
If Colum = UBound(PosComas()) + 1 Then 'Escribe el dato buscado en la variable dato
Dato = Mid(Cadena, PosComas(Colum - 1) + 1)
Else
Dato = Mid(Cadena, PosComas(Colum - 1) + 1, PosComas(Colum) - 1 - PosComas(Colum - 1))
End If
'El siguiente bloque de código elimina las comillas
'del principio y final de la variable Dato.
NumLet = Len(Dato)
If Left(Dato, 1) = Chr(34) Then
Dato = Mid(Dato, 2)
End If
NumLet = Len(Dato)
If Right(Dato, 1) = Chr(34) Then
Dato = Mid(Dato, 1, NumLet - 1)
End If
LeerDatoMATRIZ = Dato
End Function
Sub EscribirDatoMATRIZ(Colum As Long, Fila As Long, Dato As Variant, RutaArchivo As String)
'Guarda datos en un bloc notas en forma de comas... utiliza el bloc
'como una matriz ordenada por filas y columnas... [Mayo 5 / 2008]
Dim Contador As Double
Dim Vector() As Variant
Dim Caracter As String
Dim Max As Double
Dim Linea As Long
Dim Cadena As String
Dim NumLet As Long
Dim Letr As String
Dim Cont As Long
Dim PosComas() As Long
Dim Pedazo1 As String
Dim Pedazo2 As String
Dim Comas_Add As Long
If Dir(RutaArchivo) = "" Then 'Comprueba si existe archivo, en caso de no existir, lo crea.
Open RutaArchivo For Output As #1
Print #1, "Archivo de Texto creado para guardar información" & vbCrLf & "jimbenit@hotmail.com"
Close #1
End If
Linea = Fila
For j = 1 To 2 'Introduce todas las lineas del Bloc notas en un Vector llamado Vector()
Open RutaArchivo For Input As #1
While Not EOF(1) 'Cuenta las lineas del Bloc Notas
Line Input #1, Caracter
i = i + 1
If j = 1 Then
Contador = i
ElseIf j = 2 Then 'Si j = 2 , se escriben las lineas dentro del vector
Vector(i) = Caracter
End If
Wend
Close #1
If j = 1 Then
If Linea > Contador Then 'Define el tamaño del vector
ReDim Vector(1 To Linea)
Max = Linea
Else
ReDim Vector(1 To Contador)
Max = Contador
End If
i = 0
End If
Next j
For i = 1 To Max 'Obtiene la fila en string separada por comas
If i = Fila Then
Cadena = Vector(i)
End If
Next i
'Obtención de las posiciones de las comas
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
NumLet = Len(Cadena)
For i = 1 To NumLet 'Cuenta las comas dentro de la cadena
Letr = Mid(Cadena, i, 1)
If Asc(Letr) = 44 Then
Cont = Cont + 1
End If
Next i
If Colum > Cont + 1 Then 'Columna vacia
Comas_Add = Colum - (Cont + 1)
For i = 1 To Comas_Add
Cadena = Cadena & ", "
Next i
Cont = Colum - 1
End If
NumLet = Len(Cadena)
ReDim PosComas(Cont)
Cont = 0
For i = 1 To NumLet 'Coloca las posiciones de las comas dentro del vector
Letr = Mid(Cadena, i, 1)
If Asc(Letr) = 44 Then
Cont = Cont + 1
PosComas(Cont) = i
End If
Next i
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Añadiendo el dato a la cadena [Elimina el dato anterior en esa posición]
If Cont = 0 Then
Cadena = Dato
ElseIf Colum = 1 Then 'Coloca el dato al principio
Cadena = Dato & Mid(Cadena, PosComas(1))
ElseIf Colum = UBound(PosComas()) + 1 Then 'Coloca el dato al final
Cadena = Mid(Cadena, 1, PosComas(Colum - 1)) & Dato
Else
Pedazo1 = Mid(Cadena, 1, PosComas(Colum - 1))
Pedazo2 = Mid(Cadena, PosComas(Colum))
Cadena = Pedazo1 & Dato & Pedazo2
End If
'Escribiendo en el Bloc Notas
Open RutaArchivo For Output As #1
For i = 1 To Max
If i = Linea Then
Vector(i) = Cadena
Print #1, Vector(i)
Else
Print #1, Vector(i)
End If
Next i
Close #1
End Sub
