Question

快乐的驼峰日，我希望得到一些关于这个宏的帮助我相当肯定有一个简单的解决方案，但我错过了一个关键因素。

场景我有一个命名区域，用于填充用户窗体的组合框，我想允许用户添加或删除此范围内的选项，以便用户窗体只包含选项正在开发（以非用户友好的方式为非excel精明）。有一个“主列表”，包含几十个可供选择的选项，在列表的左侧，我在双击时添加了一个工作表事件，添加了一个绿色复选标记，表示该项目已被选中。

目标：从主列表中进行选择后，我希望用户单击一个按钮，该按钮将运行宏以识别列表左侧有复选标记的位置并添加对应于下一个可用行的命名范围的值。

问题：我尝试循环遍历每个“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完美地回答了我的问题，但我想我会分享我将要使用的解决方法。

原始代码标识每个选中的值并在运行宏时将它们添加到列中，而此工作表事件在双击时将值添加到命名范围列，以在主列表中的值旁边添加复选标记，同样地;删除复选标记后，从命名范围列中删除值：

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

它将所有内容粘贴在同一行中，因为你没有用每个新值来计算lastrow。

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

根据另一个

2 个答案: