Te anexo la macro
Sub CalcularModa()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
uc = Cells(1, Columns.Count).End(xlToLeft).Column
uf = Range("A" & Rows.Count).End(xlUp).Row
Range("F3:F" & uf).ClearContents
For i = 3 To uf
'For i = 977 To 977
Application.StatusBar = "Procesando fila : " & i & " de: " & uf
col1 = ""
col2 = ""
If Cells(i, "B") <> "" And Cells(i, "C") <> "" And _
Cells(i, "D") <> "" And Cells(i, "E") <> "" Then
col1 = BuscaColumna(i, "B", uc)
col2 = BuscaColumna(i, "D", uc)
'
Select Case col1
Case "": Cells(i, "F") = "No existe hora1"
Case "Error": Cells(i, "F") = "No existe fecha1"
Case Else
Select Case col2
Case "": Cells(i, "F") = "No existe hora2"
Case "Error": Cells(i, "F") = "No existe fecha2"
Case Else
Cells(i, "F").FormulaR1C1 = "=MODE(R" & i & "C" & col1 & ":R" & i & "C" & col2 & ")"
End Select
End Select
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "fin"
End Sub
'
Function BuscaColumna(i, col, uc)
'Por.Dante Amor
Set b = Rows(1).Find(Cells(i, col), lookat:=xlWhole)
If Not b Is Nothing Then
For j = b.Column To uc
h = Hour(Cells(2, j))
m = Minute(Cells(2, j))
h2 = Hour(Cells(i, Columns(col).Column + 1))
m2 = Minute(Cells(i, Columns(col).Column + 1))
If h = h2 And m = m2 Then
'col1 = j
BuscaColumna = j
Exit Function
End If
Next
Else
'Cells(i, "F") = "No existe fecha1"
BuscaColumna = "Error"
Exit Function
End If
End Function
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias