Question

我需要一个VBA脚本将单元格的值（在另一个工作表上）复制到原始参考单元格右侧的空白单元格中。参考单元是具有三个值的下拉（Verbal，Written，Demonstrated）。我需要VBA，因为一旦将值输入到单元格中，我还需要在单元格中添加其他注释。

Col G是具有下拉列表的参考单元格。 Col I是VBA代码的目的地

查找范围是：表格。（＆＃34;不要删除＆＃34;）范围（＆＃34; C2：D4＆＃34;）

非常感谢任何帮助！

Answer 1

确保您的活动表是具有下拉值的活动表。您必须拨打电话才能运行此功能。

'  This is meant to be run in a module and must be called
Sub tester()
        Dim lastRow As Long, testString As String, rng2Search As Range


            lastRow = ActiveSheet.Range("G65536").End(xlUp).Row
            For i = 1 To lastRow
                If ActiveSheet.Range("G" & i) = "Verbal" Or _
                    ActiveSheet.Range("G" & i) = "Written" Or _
                    ActiveSheet.Range("G" & i) = "Demonstrated" Then
                    Set rng2Search = Sheets("DO NOT DELETE").Range("C2:C4").Find(ActiveSheet.Range("G" & i), LookIn:=xlValues)
                        If Not rng2Search Is Nothing Then
                            ActiveSheet.Range("I" & i).Value = Sheets("DO NOT DELETE").Range("D" & rng2Search.Row).Value
                        End If
                End If
            Next i
            Set rng2Search = Nothing

        End Sub

只要G列中的单元格发生更改，您也可以将其更改为在工作表模块上运行。打开包含下拉值的工作表模块并将其粘贴到那里。

'  This will run automatically if in the worksheet module    
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng2Search As Range

        If Mid(Target.Address, 1, 2) = "$G" Then
            Set rng2Search = Sheets("DO NOT DELETE").Range("C2:C4").Find(Target.Value, LookIn:=xlValues)
                    If Not rng2Search Is Nothing Then
                        ActiveSheet.Range("I" & Target.Row).Value = Sheets("DO NOT DELETE").Range("D" & rng2Search.Row).Value
                    End If
        End If

    End Sub

根据第3个单元格的值将单元格的值复制到另一个单元格中

1 个答案: