[英]Copy value of cell into another cell based on the value of a 3rd cell
我需要一個 VBA 腳本來將單元格(在另一張紙上)的值復制到原始參考單元格右側的空白單元格中。 參考單元格是具有三個值(口頭、書面、演示)的下拉列表。 我需要 VBA,因為一旦將值輸入到單元格中,我還需要在單元格中添加其他注釋。
Col G 是帶有下拉菜單的參考單元格。 Col I 是 VBA 代碼的目的地
查找范圍是: Sheets.("DO NOT DELETE") Range("C2:D4")
任何幫助是極大的贊賞!
確保您的活動表是具有下拉值的活動表。 您必須調用才能運行此函數。
' 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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.