-1

我有一个 12 列 x 26 行的表格,名称将在单元格中随机输入。我想按照它们在表中输入的顺序生成这些名称的列表。

有任何想法吗?

4

1 回答 1

1

您并没有真正指定您想要列表的位置等,所以我对它采取了一些自由。

代码将监控Range(A1:L26)并执行以下操作

如果添加了任何文本,它将将该项目添加到列表中(即 N 和 M 列)。
如果稍后修改该单元格内的值,它将更新初始列表项。
如果清除该值,则列表项将被删除,将剩余的列表项向上移动一个。

将以下代码复制到工作表模块中(例如:Sheet1,如果您希望它在工作表 1 上处于活动状态)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Row As Integer
Dim List As Range
Set List = Range("N1")
If Not Intersect(Target, Range("A1:L26")) Is Nothing Then
    Row = 0
    Do
        If List.Offset(RowOFfset:=Row).Value = "" Then
            ' End of list or empty list, add item to list
            List.Offset(RowOFfset:=Row).Value = Target.Address
            List.Offset(RowOFfset:=Row, ColumnOffset:=1).Value = Target.Value
            Exit Do
        Else
            If List.Offset(RowOFfset:=Row).Value = Target.Address Then
                ' Target has been added already
                If Target.Value = "" Then
                    ' Target has been cleared, remove the item from the list and shift list up
                    Range(List.Offset(RowOFfset:=Row), List.Offset(RowOFfset:=Row, ColumnOffset:=1)).Delete xlShiftUp
                Else
                    ' Target has changed, update the list item (in place)
                    List.Offset(RowOFfset:=Row, ColumnOffset:=1).Value = Target.Value
                End If
                Exit Do
            Else
                Row = Row + 1
            End If
        End If
    Loop
Else
    ' Invalid Target
End If
End Sub

更新

我已经更改了代码,希望能做你想做的事。我对“每隔 2 列”有点困惑,所以我希望你的意思是 B、E、H、K 列......

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Row As Integer
Dim List As Range
Dim Column As Integer

    Set List = ThisWorkbook.Worksheets("Sheet2").Range("A1")

    If Target.Cells.Count > 1 Then Exit Sub

    Column = Target.Column
    ' This is used to determine if the column is one we are looking for
    ' eg: 2-3 = -1, 5-3-3 = -1, 8-3-3-3 = -1 etc
    Do
        Column = Column - 3
        If Column <= 0 Then Exit Do
    Loop

    If Column = -1 Then
        If Target.Row > 2 And Target.Row < 27 Then
            ' Target Match
            Row = 0
            Do
                If List.Offset(RowOffset:=Row).Value = "" Then
                    ' End of list or empty list, add item to list
                    List.Offset(RowOffset:=Row).Value = Target.Address
                    List.Offset(RowOffset:=Row, ColumnOffset:=1).Value = Target.Value
                    List.Offset(RowOffset:=Row, ColumnOffset:=2).Value = Cells(2, Target.Column).Value
                    Exit Do
                Else
                    If List.Offset(RowOffset:=Row).Value = Target.Address Then
                        ' Target has been added already
                        If Target.Value = "" Then
                            ' Target has been cleared, remove the item from the list and shift list up
                            Range(List.Offset(RowOffset:=Row), List.Offset(RowOffset:=Row, ColumnOffset:=2)).Delete xlShiftUp
                        Else
                            ' Target has changed, update the list item (in place)
                            List.Offset(RowOffset:=Row, ColumnOffset:=1).Value = Target.Value
                        End If
                        Exit Do
                    Else
                        Row = Row + 1
                    End If
                End If
            Loop
        Else
            ' Target Column, Non-Target Row
        End If
    Else
        ' Non-Target Column
    End If

End Sub
于 2013-03-05T23:41:48.857 回答