Modificar formulario con condiciones en excel
Tengo un formulario en el cual al escribir dos dígitos en los cuadros de arriba me arroja la cantidad de veces que esta dicha coincidencia en determinado rango en el cuadro de abajo y quisiera agregarle lo siguiente
1. Que me de el numero de la segunda y tercera fila en que más aparece esa coincidencia en diferente cuadro como el primer procedimiento
2. Las veces que aparece esa coincidencia en esa fila
1 Respuesta
Respuesta de Dante Amor
1
Dante te envié el libro al correo
Puedes explicarlo con ejemplos.
Y es muy importante que pongas cuál es el resultado que quieres.
Listo ya te envío el ejemplo
Ya entendí tu petición, pongo otro ejemplo:
El código completo lo debes poner en tu userform:
Option Explicit
'
Dim numordenados As New Collection, llaves As New Collection
'
Private Sub CommandButton8_Click()
Dim r As Range, f As Range
Dim cell As String, t As String
Dim dic As Object, ky As Variant
'
t = IIf(Uno = "", "?", Uno) & IIf(Dos = "", "?", Dos) & IIf(Tres = "", "?", Tres) & IIf(Cuatro = "", "?", Cuatro)
Set numordenados = Nothing
Set llaves = Nothing
ListBox1.Clear
Filax = ""
Vecesx = ""
TextBox1 = ""
TextBox3 = ""
TextBox2 = ""
TextBox4 = ""
'
Set dic = CreateObject("Scripting.Dictionary")
Set r = Sheets("hoja1").Range("Z1:TW42")
Set f = r.Find(t, , xlValues, xlPart)
'
If Not f Is Nothing Then
cell = f.Address
Do
ListBox1.AddItem f.Address & " : " & f.Value
If Not dic.exists(f.Row) Then
dic(f.Row) = 1
Else
dic(f.Row) = dic(f.Row) + 1
End If
Set f = r.FindNext(f)
Loop While Not f Is Nothing And f.Address <> cell
End If
'
For Each ky In dic.keys
Call Addnum(dic(ky), ky)
Next
'
If numordenados.Count > 0 Then
Filax = llaves(1)
Vecesx = numordenados(1)
End If
If numordenados.Count > 1 Then
TextBox1 = llaves(2)
TextBox3 = numordenados(2)
End If
If numordenados.Count > 2 Then
TextBox2 = llaves(3)
TextBox4 = numordenados(3)
End If
End Sub
'
Sub Addnum(n, ky)
Dim m As Long
'Ordena números en una colección
For m = 1 To numordenados.Count
If numordenados(m) < n Then
numordenados.Add n, before:=m
llaves.Add ky, before:=m
Exit Sub
End If
Next
Numordenados. Add n
Llaves. Add ky
End Sub
