Jump to content

Encriptar datos de la Hoja, por ejemplo codigo binario o similar, y solo mostrar el contenido en Userform


Recommended Posts

 

Buenas tardes amigos como estan. 

Les escribo de nuevo para hacerles una consulta, tengo mi archivo padron, con un user form inicial y otro userform padron, en el cual se buscan los datos de la hoja PNAC. Los userform y las funciones me ejecuta relativamente bien, es un poco lento no mas.

Pero lo que me exigen en mi trabajo, como son datos privados, que para distribuir el archivo, debo encriptar los datos, es decir, me piden que los datos que estan en la Hoja PNAC, no sean legibles si llegaria a poder abrirse, sino que sean caracteres tipo codigo o simbolo....

Y que solo se puedan ver de forma legible, es decir entiendo las palabras y datos a traves del formulario de consulta "PADRON".

Es posible hacer esto?, me podrian guiar como o donde buscar, porque hace dos dias llevo investigando en internet y no logro encontrar lo que estoy buscando...

Les comparto el archivo con el codigo...

 

un abrazo!!!

PADRON.zip

Link to comment
Share on other sites

Algo sencillo, te dejo una función que encripta/desencripta de forma alternativa.

Con la hoja PNAC activada:

'En un módulo normal

Function EncriptaDesencripta(Texto As String) As String
For y = 1 To Len(Texto)
   Mid(Texto, y, 1) = Chr(255 - Asc(Mid(Texto, y, 1)))
Next
EncriptaDesencripta = Texto
End Function

Sub Ejemplo() 'Ejemplo de funcionamiento de la función
Range("B2") = EncriptaDesencripta(Range("B2"))
End Sub

 

Link to comment
Share on other sites

Hace 39 minutos , Antoni dijo:

Algo sencillo, te dejo una función que encripta/desencripta de forma alternativa.

Con la hoja PNAC activada:

'En un módulo normal

Function EncriptaDesencripta(Texto As String) As String
For y = 1 To Len(Texto)
   Mid(Texto, y, 1) = Chr(255 - Asc(Mid(Texto, y, 1)))
Next
EncriptaDesencripta = Texto
End Function

Sub Ejemplo() 'Ejemplo de funcionamiento de la función
Range("B2") = EncriptaDesencripta(Range("B2"))
End Sub

 

ERES UN GENIO ANTONI!!! MUCHISIMAS GRACIAS POR TU APORTE!!!

Lo he probado y funciona excelente en el rango que pusiste de ejemplo... 

estuve probando para que me seleccione todo el rango de datos que esta en la hoja activa y no logro, me estare equivocando en el metodo? o porque no me toma...

Function EncriptaDesencripta(Texto As String) As String
For y = 1 To Len(Texto)
   Mid(Texto, y, 1) = Chr(255 - Asc(Mid(Texto, y, 1)))
Next
EncriptaDesencripta = Texto
End Function

Sub Ejemplo() 'Ejemplo de funcionamiento de la función
Dim fila As Long

'En esta parte estaba intentando seleccionar todos los datos hasta la ultima fila desde la columna A a la G
fila = Hoja1.Cells(Rows.Count, "A").End(xlUp)
Range(Hoja1.Cells(fila, 7)) = EncriptaDesencripta(Range(Hoja1.Cells(fila, 7)))

End Sub
 

 

Link to comment
Share on other sites

 

'Ejemplo encriptar/desencriptar toda la hoja PNAC
Sub EncriptaDesencriptaPNAC()
Application.ScreenUpdating = False
x = 2
Do Until Range("A" & x) = ""
   For y = 1 To 7
      Cells(x, y) = EncriptaDesencripta(Cells(x, y))
   Next
   x = x + 1
Loop
End Sub

'Ejemplo para la fila 100
Sub EjemploFila100()
Application.ScreenUpdating = False
For y = 1 To 7
   Cells(100, y) = EncriptaDesencripta(Cells(100, y))
Next
End Sub

Nota: En el archivo que has subido hay unas 7.000 filas con información y más de 1.000.000 en blanco.

Edited by Antoni
Link to comment
Share on other sites

Hace 20 horas, Antoni dijo:

 

'Ejemplo encriptar/desencriptar toda la hoja PNAC
Sub EncriptaDesencriptaPNAC()
Application.ScreenUpdating = False
x = 2
Do Until Range("A" & x) = ""
   For y = 1 To 7
      Cells(x, y) = EncriptaDesencripta(Cells(x, y))
   Next
   x = x + 1
Loop
End Sub

'Ejemplo para la fila 100
Sub EjemploFila100()
Application.ScreenUpdating = False
For y = 1 To 7
   Cells(100, y) = EncriptaDesencripta(Cells(100, y))
Next
End Sub

Nota: En el archivo que has subido hay unas 7.000 filas con información y más de 1.000.000 en blanco.

Hola Antoni, gracias por notarlo!, había reducido la cantidad de filas para que no sea tan pesado el archivo pero lo cierto es que tiene 948.500 registros!!!  

1.probe la función y el código que me pasaste, como pocos datos funciona a la perfección, pero con todos los registros, directamente se me tilda y se me cierra la aplicación.

Lo que hice fue " call EncriptaDesencriptaPNAC()" en el evento inicialize del Userform Padrón comparto el archivo con la totalidad de los datos,  que no me esta funcionando... 

Crees que es posible encontrar una forma de hacerlo, que no sea tan lenta y que no me cierre el archivo? o definitivamente no se podrá con esa cantidad de datos?- la consulta es porque me exigen el encriptado de datos por seguridad y no se que otra forma pueda hacerlo.

2. Por otro lado consulto, es posible hacer mas rápida la búsqueda en el formulario, a través del evento change de un textbox, porque hasta ahora lo tenia programada la busqueda a traves del Boton buscar o consultar?

lo comparto al archivo por Drive porque al tener todos los registros supera el peso por mas que lo comprima...

desde ya Antoni, muy agradecida por tu ayuda y fascinada con tu dominio de VBA...

gracias!!!

https://drive.google.com/file/d/183NOtT0RWPqtcwiPyy166KrrpxtpGU4A/view?usp=sharing

Link to comment
Share on other sites

Sub EncriptaDesencriptaPNAC()
Application.ScreenUpdating = False
x = 2
i = Timer
Do Until Range("A" & x) = ""
   For y = 1 To 7
      Cells(x, y) = EncriptaDesencripta(Cells(x, y))
   Next
   If x Mod 5000 = 0 Then
      Application.StatusBar = "Procesando fila: " & x & "    Tiempo total: " & Timer - i
      Application.ScreenUpdating = True
      DoEvents
      Application.ScreenUpdating = False
   End If
   x = x + 1
Loop
End Sub

Prueba así, en la barra de estado de Excel irá apareciendo el avance del proceso, el tiempo total para encriptar el archivo que has subido ha sido de 45 minutos más o menos. (2 GB de RAM a 1,8 Mz)

En cuanto a la búsqueda en el formulario, es inviable desencriptar los datos cada vez que cargas el formulario.

El único proceso de búsqueda es por valor exacto, por aproximación no es posible por la gran cantidad de información.

Excel no esta pensado para tratar volúmenes de información como el que planteas.

Si te interesa una búsqueda como la planteada, sube un archivo con unos centenares de registros y el formulario correcto, ya que en el último archivo el formulario y los datos no se corresponden.

Link to comment
Share on other sites

Hola @Antoni muchisimas  gracias por tomarte el tiempo para explicarme eso era justamente lo que queria saber!!

voy hacer un filtrado por comunidades para reducir el volumen de datos... 

muchisimas gracias he probado el codigo que me has pasado, y con datos filtrados por comunidad si funciona y no es tan lento. muchisimas gracias por la ayuda y sobre todo por la explicacion.

 

Damos por cerrado el tema.

Que tengas una excelente semana!

 

Link to comment
Share on other sites

  • Crear macros Excel

  • Posts

    • =ELEGIR(F20,7500,5000,5000,3500,3500,3500,2500,2500,2500,2500,2500,1500) Espero te sirva  
    • ya te di acceso,me parecio raro que no pudieras entrar pero ya deberias entrar,hace mucho que me suscribi a esta pagina y simpre pude subir mi archivo de ejemplo,pero ahora me doy cuenta que si no pago una tarifa de membresia no podre subir ejemplos para que puedan prestar su ayuda 
    • ya te di acceso,me parecio raro que no pudieras entrar pero ya deberias entrar
    • Coloca esta subrutina y el resultado lo pondrá en la Hoja Principal "E15" hacia abajo... Saludos   Sub concatena()     Set DATOS = Worksheets("Verificar Matriz")     Sheets("principal").Select     Range("E15:E5000").ClearContents     rt = 5     RD = 6     RS = 15     Do While DATOS.Cells(RD, 4) <> ""         pasa = 0         For C = 5 To 22             If DATOS.Cells(RD, C) <> "0" Then                 pasa = pasa + 1             End If         Next         If pasa > 0 Then             CADENA = ""             For C = 5 To 22                 If DATOS.Cells(RD, C) > 0 Then                     If Len(CADENA) > 0 Then                         CADENA = CADENA & ","                     End If                     CADENA = CADENA & C - 4 & "-" & DATOS.Cells(rt, C) & "=" & Chr(34) & DATOS.Cells(RD, C) & Chr(34)                 End If             Next             Cells(RS, "E") = CADENA             RS = RS + 1         End If         RD = RD + 1     Loop End Sub  
  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy