使用基于另一列中的值的一列中的值填充范围

快乐的一天，所有我希望得到一些帮助，这个macros我相当肯定有一个简单的解决scheme，但我错过了一个关键因素。

场景︰我有一个命名的范围，填充用户窗体的combobox，我想允许用户添加或删除该范围内的select，所以用户窗体只包含他们正在工作的select（用户友好的方式非Excel精明） 。 有一个“主列表”，其中包含几十个select可供select，在列表的左侧，我已经添加了一个工作表事件双击，添加一个绿色的复选标记，指示该项目被选中。

目标：在从主列表中进行select之后，我希望用户单击一个button，该button将运行一个macros来标识列表左侧的复选标记，并将相应的值添加到下一个可用的命名范围行。

问题：我试图循环每个“P”（webdings 2复选标记），并将值添加到右侧在技术上工作，但它将值添加到同一个单元格导致只有最后一个项目检查保持。

我怎样才能循环通过每个“P”，并将其分别添加到一行？

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 

我已经玩了一些改动，并最终得到相同或类似的结果。 任何帮助将非常感激！ 同时我想我会尝试添加和删除每个值时添加复选标记，看看是否更好的工作。

编辑：所有; UGP完美地回答了我的问题，但认为我会分享我将要使用的解决方法。

尽pipe原始代码标识每个选中的值，并在运行macros时将它们添加到列中，但是此工作表事件在双击后将值添加到命名区域列，以便在主列表中的值旁边添加复选标记。 删除复选标记时从命名区域列中删除值：

 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

它粘贴在同一行的所有东西，因为你没有计算每一个新的价值拉斯特罗。

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

Answer 2

这不是一个确切的解决办法，但可能会让你开始正确的方向。 我假设你的绿色复选标记是一个形状。 我不知道它是什么形状，所以你将不得不改变线。 我用“右箭头”形状来代替。 它应该把所有的“检查”行号放入一个数组，然后您可以使用从这些行获取数据。

 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