Kopiere Wert der Zelle in eine andere Zelle basierend auf dem Wert einer dritten Zelle

Question

Ich brauche ein VBA-Skript, um den Wert einer Zelle (auf einem anderen Blatt) in eine leere Zelle zu kopieren, die sich rechts von der ursprünglichen Referenzzelle befindet. Die Referenzzelle ist ein Drop Down mit drei Werten (Verbal, Written, Demonstrated). Ich brauche VBA, weil, sobald der Wert in die Zelle eingegeben wurde, ich auch zusätzliche Kommentare in die Zelle hinzufügen muss.

Spalte G ist die Referenzzelle mit einem Dropdown. Col I ist das Ziel der VBA-Code

Der aufblicken Bereich ist. Sheets ("DO NOT DELETE") Range ("C2: D4")

Jede Hilfe ist sehr zu schätzen!

Answer 1

Stellen Sie sicher, dass Ihr Activesheet mit den Dropdown-Werten übereinstimmt. Sie müssen einen Aufruf ausführen, um diese Funktion auszuführen.

' 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 

Sie können dies auch ändern auf dem Arbeitsblatt-Modul ausgeführt, wenn eine Zelle in der Spalte G geändert wird. Öffnen Sie das Arbeitsblattmodul, das Ihre Dropdown-Werte enthält, und fügen Sie es dort ein.

' 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