如何将突出显示的单元格值发送到另一列中的另一个单元格?

时间:2015-09-07 15:20:31

标签: excel vba

早上好,

我制作了一个宏来突出显示用户输入的单元格值,基本上它突出显示的是G,I和J列中的值。列G中的值具有列I或J具有的值,但它们不是为了。我希望我的宏做的是匹配已经突出显示的这些值并将它们移动到列H,例如,如果G3具有与I5相同的值,则将值从I5移动到H3。

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 = 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 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



            ' 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

1 个答案:

答案 0 :(得分:0)

如果G3具有与I5相同的值,则将值从I5移动到H3。

你的要求很奇怪。

您编写了突出显示单元格的代码。

你实际上说的是,以及要移动它们的细胞高亮。

但是,你真的想要移动值(所以它不再在原始单元格中)吗?如果没有,那么您只需将公式添加到要将值复制到的单元格中。

如果您确实希望VBA移动该值,则需要添加在应用颜色后移动值的代码。

通过在行之后添加代码,可以轻松地移动该值:

If Not resultado Is Nothing Then

添加此代码

    Dim G as integer, H as integer, I as integer
    ' note 7 represents the 7th column ie G

    colG = 7
    colH = 8
    colI = 9 

    if cells(resultado.row,colG) = cells(resultado.row,colI) 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,colI)
        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