2015-09-03 3 views
1

Я сделал этот макрос, чтобы выделить те же значения на одном листе, но я хотел бы, чтобы он один за другим не выделял все числа одновременно.Как сравнить две колонки в Excel на одном листе?

Sub series() 
    'Definición de variables 
    Dim rango As String 
    Dim valor As String 
    Dim resultado As Range 
    Dim primerResultado As String 
    Dim cont As Integer 
    'Solicitar información al usuario 
    rango = "A1:XFD1048576" 
    valor = InputBox("Ingresa el VALOR a buscar:") 
    If valor = "" Then Exit Sub 
    'Inicializar contador de coincidencias 
    cont = 0 'Primera búsqueda del valor dentro del rango 
    Set resultado = Range(rango).Find(What:=valor, _ 
        LookIn:=xlValues, _ 
        LookAt:=xlWhole, _ 
        SearchOrder:=xlByRows, _ 
        SearchDirection:=xlNext, _ 
        MatchCase:=False, _ 
        SearchFormat:=False) 
    If Not resultado Is Nothing Then 'Si el resultado de la búsqueda no es vacío 
     primerResultado = resultado.Address 
     Do        'Inicia bucle para hacer varias búsquedas 
      cont = cont + 1 
      resultado.Interior.ColorIndex = 4 'Cambia el color de fondo de la celda 
      Set resultado = Range(rango).FindNext(resultado) 'Vuelve a buscar el valor 
     Loop While Not resultado Is Nothing And resultado.Address <> primerResultado 
    Else 
     cont = 0 
     MsgBox "Se encontraron " & cont & " coincidencias." 
     'valor = InputBox("Ingresa el VALOR a buscar:") 
    End If 
    Application.Run ("series") 
    'valor = InputBox("Ingresa el VALOR a buscar:") 
    'Muestra un cuadro de diálogo con el número de coincidencias 
    'MsgBox "Se encontraron " & cont & " coincidencias." 
End Sub 
+0

Мое предложение, чтобы установить 2 массивов на две колонки, которые вы хотите сравнить затем запустить цикл через них сравнения. Это будет быстрее, чем у вас, и намного легче понять. –

+0

Я переформатировал ваш опубликованный код - дайте мне знать, если мне что-то изменить –

ответ

0

Это попросит подтверждение от пользователя, чтобы выделить каждую ячейку найден (непроверенные)

Option Explicit 

Public Sub series() 
    'Definición de variables (Definition of variables) 
    Dim rango As String, valor As String, resultado As Range 
    Dim primerResultado As String, cont As Integer 

    'Solicitar información al usuario (Get information from the user) 
    rango = ActiveSheet.UsedRange 
    valor = InputBox("Ingresa el VALOR a buscar:") 
    If valor = "" Then Exit Sub 

    cont = 0 'Inicializar contador de coincidencias (Initialize Find) 

    'Primera búsqueda del valor dentro del rango (First search for value in the range) 
    Set resultado = Range(rango).Find(What:=valor, _ 
        LookIn:=xlValues, _ 
        LookAt:=xlWhole, _ 
        SearchOrder:=xlByRows, _ 
        SearchDirection:=xlNext, _ 
        MatchCase:=False, _ 
        SearchFormat:=False) 

    If Not resultado Is Nothing Then 'Si el resultado de la búsqueda no es vacío 
     primerResultado = resultado.Address 
     Do        'Inicia bucle para hacer varias búsquedas 
      If MsgBox("Resaltar celular?", vbYesNo) = vbYes Then 
       cont = cont + 1 
       resultado.Interior.ColorIndex = 4 'Cambia el color de fondo de la celda 
      End If 
      Set resultado = Range(rango).FindNext(resultado) 'Vuelve a buscar el valor 
     Loop While Not resultado Is Nothing And resultado.Address <> primerResultado 
    Else 
     MsgBox "Se encontraron " & cont & " coincidencias." 
    End If 
End Sub 
+0

Спасибо! Оно работает! –