Los datos expuestos en este blog, son solo de índole informativo. Por favor realiza siempre una copia de seguridad antes de realizar cualquier cambio en tu proyecto.
MS Excel 2003: contar pares coincidentes
Este tutorial de Excel explica cómo escribir una macro para contar el número de pares coincidentes en Excel 2003 y versiones anteriores (con capturas de pantalla e instrucciones paso a paso).
P: En Microsoft Excel 2003/XP/2000/97, tengo una hoja de cálculo con los números ganadores de la lotería. Quiero contar cuántas veces aparece un par de números en varios sorteos. ¿Cómo puedo hacer esto?
Respuesta: Esto se puede hacer usando código VBA para generar conteos de pares coincidentes y luego usando la función BUSCARV para mover el resultado a una matriz.
Veamos un ejemplo.
Descargue la hoja de cálculo de Excel (que se muestra a continuación)
En esta hoja de cálculo de ejemplo, tenemos una tabla llamada “Datos de sorteo” que contiene los números ganadores de varios sorteos. Hay un botón en esta hoja llamado “Actualizar estadísticas de pares” que llama a una macro llamada UpdatePairStats.
Cuando se ejecuta la macro, completará una hoja llamada “PairStats” con recuentos de pares coincidentes, como este:
Cuando se complete la macro, aparecerá el siguiente cuadro de mensaje:
En la hoja denominada Pares, verá que la matriz se rellena con logaritmos coincidentes (según la fórmula BUSCARV).
La matriz utiliza la siguiente fórmula (la celda C2 contiene la siguiente fórmula):
=IF(ISNA(VLOOKUP(Pairs!$A2 & "." &Pairs!C$1,PairStats!$A:$D,4,FALSE)),"",VLOOKUP(Pairs!$A2 & "." &Pairs!C$1,PairStats!$A:$D,4,FALSE))
Lo que hace esta fórmula es realizar una BUSCARV en números concatenados (separados por “.”). Si no se encuentra ninguna coincidencia, se devuelve una cadena vacía (“”).
Puede presionar Alt+F11 para ver el código VBA.
codigo macro
El código de la macro se ve así: (que se encuentra en el Módulo 1)
Sub UpdatePairStats() Dim LRange As Variant Dim LRows As Long Dim LCols As Long Dim C As New Collection Dim LItem As Long Dim LDesc As String Dim Counts(10000, 4) As String Dim i As Long, j As Long, k As Long On Error Resume Next 'Select sheet where data resides Sheets("Draw Data").Select 'Data range (where draw information resides) LRange = Range("C2:H1151") LRows = UBound(LRange, 1) LCols = UBound(LRange, 2) 'Loop through each row in LRange (find pairs) For i = 1 To LRows 'j and k create the pairs For j = 1 To LCols - 1 For k = j + 1 To LCols 'Separate pairs with a "." character (smaller number first) If LRange(i, j) < LRange(i, k) Then LDesc = LRange(i, j) & "." & LRange(i, k) Else LDesc = LRange(i, k) & "." & LRange(i, j) End If 'Add new item to collection ("on error resume next" is 'required above in this procedure because of this line of code) C.Add C.Count + 1, LDesc 'Retrieve indexnumber of new item LItem = C(LDesc) 'Add pair information to new item If Counts(LItem, 0) = "" Then Counts(LItem, 0) = LDesc Counts(LItem, 1) = LRange(i, j) Counts(LItem, 2) = LRange(i, k) End If 'Increment stats counter If Counts(LItem, 3) = "" Then Counts(LItem, 3) = "1" Else Counts(LItem, 3) = CStr(CInt(Counts(LItem, 3)) + 1) End If Next k Next j Next i 'Paste pairs onto sheet called PairStats Sheets("PairStats").Select Cells.Select Selection.Clear Cells(1, 1).Resize(C.Count, 4) = Counts 'Format headings Range("A1").FormulaR1C1 = "'Number1.Number2" Range("B1").FormulaR1C1 = "'Number1" Range("C1").FormulaR1C1 = "'Number2"Range("D1").FormulaR1C1 = "'Occurrences" Range("A1:D1").Select Selection.Font.Bold = True Selection.Font.Underline = xlUnderlineStyleSingle Columns("A:D").EntireColumn.AutoFit Range("F1").Select Range("F1").FormulaR1C1 = "Last Updated on " & Now() Sheets("Pairs").Select MsgBox "Pair statistics have been updated." End Sub
Tenga en cuenta que usted tiene que personalizar Alcance variable para que coincida con el número de filas y columnas de datos.