füllen Bereich mit Werten aus einer Spalte basierend auf den Werten in einem anderen

Question

Happy bucket Tag alle, Ich hoffe, etwas Hilfe mit diesem Makro zu bekommen, dass ich ziemlich sicher bin, hat eine einfache Lösung, aber mir fehlt ein Schlüsselfaktor .

Szenario: ich einen benannten Bereich haben, der die Combobox eines Userform auffüllt, möchte ich einen Benutzer erlauben, Entscheidungen aus diesem Bereich hinzuzufügen oder zu entfernen, so dass die Userform nur die Wahl enthält, was sie auf arbeiten (in einer benutzerfreundlichen Art und Weise für den Nicht-Excel-savvy). Es gibt eine "Master-Liste", die Dutzende von Auswahlmöglichkeiten enthält. Links von der Liste habe ich ein Arbeitsblatt-Ereignis mit Doppelklick hinzugefügt, das ein grünes Häkchen hinzufügt und anzeigt, dass das Element ausgewählt ist.

Ziel: Nachdem ich eine Auswahl aus der Hauptliste getroffen habe, möchte ich, dass der Benutzer auf eine Schaltfläche klickt, die ein Makro zum Identifizieren eines Häkchens links neben der Liste und zum Hinzufügen des entsprechenden Werts zu benannter Bereich in der nächsten verfügbaren Zeile.

Ausgabe: mein Versuch, durch jede „P“ (webdings 2 Haken) und das Hinzufügen der Wert auf der rechten Seite bei Looping technisch funktioniert, aber es ist das Hinzufügen die Werte in die gleiche Zelle führt nur der letzte Punkt abgehakt bleiben.

Wie kann ich jedes "P" durchlaufen und es einer Zeile separat hinzufügen?

Sub Macro3() 
Dim lastrow As Long, ws As Worksheet 
Set ws = Sheets("named content") 
lastrow = ws.Range("F" & Rows.Count).End(xlUp).Row + 1 
Dim c As Range 
For Each c In Range("MasterList").Offset(, -1).Cells 
    If c = "P" Then 
    ws.Range("F" & lastrow).Value = c.Offset(, 1) 
     End If 
Next c 
End Sub 

Ich habe mit ein paar Änderungen rumgespielt und alle mit dem gleichen oder einem ähnlichen Ergebnis enden. Jede Hilfe wäre sehr geschätzt! In der Zwischenzeit denke ich, dass ich versuchen werde, jeden Wert hinzuzufügen und zu entfernen, wenn die Häkchen hinzugefügt werden, und sehe, ob das besser funktioniert.

EDITIEREN: Alle; UGP beantwortete meine Frage perfekt, dachte aber, ich würde die Problemumgehung teilen, die ich verwenden würde. Wenn der ursprüngliche Code jeden überprüften Wert identifiziert und sie der Spalte beim Ausführen des Makros hinzufügt, fügt dieses Tabellenereignis den Wert der benannten Bereichsspalte hinzu, indem Sie durch Doppelklicken das Häkchen neben dem Wert in der Hauptliste hinzufügen , und ebenfalls; Entfernt den Wert aus der Spalte benannten Bereichs, wenn das Häkchen entfernt wird:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
Dim lastrow As Long, ws As Worksheet 
Set ws = Sheets("named content") 
lastrow = ws.Range("F" & Rows.Count).End(xlUp).Row + 1 
If Not Intersect(Target, Range("MasterList").Offset(, -1)) Is Nothing Then 
     Application.EnableEvents = False 
     If ActiveCell.Value = "P" Then 
      ActiveCell.ClearContents 
      For c = lastrow To 3 Step -1 
      If ws.Cells(c, 6).Value = ActiveCell.Offset(, 1) Then 
      Cells(c, 6).Delete Shift:=xlUp 
      End If 
      Next 

     Else 
      ActiveCell.Value = "P" 
      ws.Range("F" & lastrow).Value = ActiveCell.Offset(, 1) 
     End If 
     Cancel = True 
    End If 
    Application.EnableEvents = True 
End Sub 

Answer 1

Sein Einfügen alles in der gleichen Zeile, weil Sie die LastRow mit jedem neuen Wert berechnen abgepfiffen.

Answer 2

Dies ist keine genaue Lösung, aber könnte Sie in die richtige Richtung starten. Ich nehme an, dass Ihr grünes Häkchen eine Form ist. Ich weiß nicht, um was für eine Form es sich handelt, deshalb musst du die Linie dafür ändern. Ich habe "Right Arrow" -Formen als Ersatz verwendet. Es sollte alle "geprüften" Zeilennummern in ein Array setzen, das Sie dann verwenden können, um die Daten aus diesen Zeilen zu erhalten.

Public Sub LoopThroughShapes() 
Dim Shape As Shape, myArray() As Variant, arrayCounter As Long 

ReDim myArray(1 To 1) 
arrayCounter = 1 
For Each Shape In ActiveSheet.Shapes 
    If InStr(1, Shape.Name, "Right Arrow") <> 0 Then 
     Shape.Select 
     Debug.Print Shape.Name, Shape.TopLeftCell.Row 
     ReDim Preserve myArray(1 To arrayCounter) 
     myArray(arrayCounter) = Shape.TopLeftCell.Row 
     arrayCounter = arrayCounter + 1 
    End If 
Next 

End Sub