匹配列之间的值

时间:2015-09-14 17:52:57

标签: excel vba excel-vba

我一直很难过。此代码可帮助我突出显示并匹配列J和G之间的值,然后将值从列J移动到列H中,以便它可以在列G中的相同值旁边,但只有在同一行中它才有效。我希望它能够工作,即使它在J列的另一行。这个图像显示了我的问题。

enter image description here

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
    Dim G As Integer, H As Integer, I As Integer, J As Integer

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

    ' note 7 represents the 7th column ie G

    colG = 7
    colH = 8
    colI = 9
    colJ = 10


    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 Valor?", 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

            If Cells(resultado.Row, colG) = Cells(resultado.Row, colJ) Then

        ' OPTION 1
        ' if value in column G has the same value that in column I
        ' move the value from column I to column H
        Cells(resultado.Row, colH) = Cells(resultado.Row, colJ)
        resultado.Value = ""

        ' OPTION 2
        ' if G3 has the same value that I5, move the value from I5 to H3.
        ' Note the use of -2
        ' Cells(resultado.Row, colH) = Cells(resultado.Row, colI - 2)

        ' now clear teh source cell
        resultado.Value = ""


        End If

            ' Display a simple message box.


        Loop While Not resultado Is Nothing And resultado.Address <> primerResultado
           MsgBox ("Valores Encontrados: " & cont)
    Else
        MsgBox "Se encontraron " & cont & " coincidencias."
    End If
End Sub

3 个答案:

答案 0 :(得分:0)

现在,看看你的逻辑陈述: =If Cells(resultado.Row,colG) = Cells(resultado.Row,colJ) Then

这就是为什么它只适用于同一行。你应该做的是循环你的Column J范围。

试试这个(在If Cells(resultado.ROw,G) = Cells(resultado.Row,colJ)之前替换end if之前“显示一个简单的消息框”):

Dim cel As Range, cel2 As Range
Dim lastRow&

lastRow = Cells(Rows.Count, 10).End(xlUp).Row

For Each cel In Range(Cells(1, 7), Cells(lastRow, 7))
    cel.Select ' Comment this out when using, it's just here so you can walk through (with F8) and visually see the cel
    For Each cel2 In Range(Cells(1, 10), Cells(lastRow, 10))
        cel2.Select 'Same here, re: comment
        If cel2.Value = cel.Value Then
            cel.Offset(0, 1).Value = cel2.Value
            cel2.Value = ""
            Exit For
        End If
    Next cel2

Next cel

答案 1 :(得分:0)

您也可以使用第H列中的公式执行此操作。

示例中的公式为:

=IF(ISERROR(INDEX($C$1:$C$8,MATCH(A1,$C$1:$C$8,0))),"",INDEX($C$1:$C$8,MATCH(A1,$C$1:$C$8,0)))

您只需修改引用即可。它在A1中查看C:C中是否存在匹配。如果是这样,它将值放在B1中。

enter image description here

答案 2 :(得分:0)

谢谢!这两个答案对我有用!这是我的代码修改。

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 = "A1:XFD1048576"
        valor = MsgBox("Deseas Mover los Valores?:")
        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 Valor?", 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

            Dim cel As Range, cel2 As Range
            Dim lastRow As Long
            lastRow = Cells(Rows.Count, 10).End(xlUp).Row
            For Each cel In Range(Cells(1, 7), Cells(lastRow, 7))
            For Each cel2 In Range(Cells(1, 10), Cells(lastRow, 10))
            If cel2.Value = cel.Value Then
            cel.Offset(0, 1).Value = cel2.Value
            cel2.Value = ""
            End If
            Next cel2
            Next cel

            ' If Cells(resultado.Row, colG) = Cells(resultado.Row, colJ) Then

            ' OPTION 1
            ' if value in column G has the same value that in column I
            ' move the value from column I to column H
            ' Cells(resultado.Row, colH) = Cells(resultado.Row, colJ)
            ' resultado.Value = ""

            ' OPTION 2
            ' if G3 has the same value that I5, move the value from I5 to H3.
            ' Note the use of -2
            ' Cells(resultado.Row, colH) = Cells(resultado.Row, colI - 2)

            ' now clear teh source cell
            ' resultado.Value = ""


            ' End If

                ' Display a simple message box.


            ' Loop While Not resultado Is Nothing And resultado.Address <> primerResultado
            ' MsgBox ("Valores Encontrados: " & cont)
        ' Else
            ' MsgBox "Se encontraron " & cont & " coincidencias."
        ' End If
    End Sub