我有一个 12 列 x 26 行的表格,名称将在单元格中随机输入。我想按照它们在表中输入的顺序生成这些名称的列表。
有任何想法吗?
您并没有真正指定您想要列表的位置等,所以我对它采取了一些自由。
代码将监控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