我有一个数据集，其中 C 列是 M 代表会员，N 代表非会员。我正在尝试创建一个宏/VBA，其中如果键入 M，则不会发生任何情况，但如果将 M 更改为 N，则该行将移动到数据集的末尾，如果将 N 更改为 M，则该行会向上移动。数据集总是被添加到，所以我也不确定是否可以用基本上整本书的范围来完成它，或者是否需要一个设定的范围。我对此很陌生，所以解释越详细越好。
我尝试使用通过视频找到的 VBA，但他们都没有做我希望他们做的事情。
这是示例数据：
| 姓名 | DOB | 会员/非会员 |
|---|---|---|
| 内尔·杜根 | 2000 年 5 月 17 日 | M |
| 米歇尔·乔伊斯 | 九月。 1982 年 18 日 | N |
| 伊丽莎白·卡西迪 | 九月。 2000 年 30 日 | N |
| 布兰迪·里格斯 | 七月。 1982 年 12 月 24 日 | M |
| 弗洛拉·格里尔 | 十月。 1997 年 12 月 23 日 | N |
| 帕蒂·皮尔森 | 六月。 1984 年 16 日 | M |
| 胡里奥·博伊德 | 八月。 1983 年 7 月 | N |
| 玛丽莲·斯特里克兰 | 六月。 1983 年 9 月 | N |
| 莫娜·赫尔利 | 十月。 1991 年 2 月 | M |
| 丹·菲尔普斯 | 十一月2002 年 5 月 | N |
| 希望乔丹 | 十月。 2000 年 16 日 | M |
| 奥斯汀·本杰明 | 八月。 1992 年 5 月 | N |
| 罗比雷耶斯 | 七月。 1997 年 12 月 27 日 | N |
| 穆里尔·卡森 | 七月。 1981 年 15 日 | N |
| 斯宾塞·麦金泰尔 | 三月。 1989 年 13 日 | M |
| 沃伦·卡德纳斯 | 一月。 1988 年 4 月 | M |
| 克里斯汀·萨利纳斯 | 三月。 2003 年 25 日 | N |
| 奥斯卡之恋 | 四月1987 年 19 日 | M |
| 梅根·莫兰 | 七月。 1993 年 12 月 25 日 | M |
| 克劳迪娅·加纳 | 二月2001 年 15 日 | M |
我尝试使用的代码是：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim LastRow As Long
Dim memberColumn As Long
Dim cell As Range
' Set reference to the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1") ' Reference to "Sheet1"
' Define the column number for "Member" (Assuming "Member" is in Column C, which is column 3)
memberColumn = 3 ' Column C is column 3, update if "Member" is in another column
' Check if the change happened in any cell in the worksheet
If Not Intersect(Target, ws.UsedRange) Is Nothing Then
Application.EnableEvents = False ' Disable events to prevent an infinite loop
Application.ScreenUpdating = False ' Disable screen updating for performance
' Loop through all cells in the changed range
For Each cell In Intersect(Target, ws.Columns(memberColumn))
If cell.Row > 1 Then ' Skip the header row (assuming row 1 is the header)
LastRow = ws.Cells(ws.Rows.Count, memberColumn).End(xlUp).Row ' Find the last row with data in column C
' If the value in the "Member" column is "N"
If cell.Value = "N" Then
' Move the row to the bottom of the data set
ws.Rows(cell.Row).Cut
ws.Rows(LastRow + 1).Insert Shift:=xlDown
' If the value in the "Member" column changes from "N" to "M"
ElseIf cell.Value = "M" Then
' Move the row back to the second row (just below the header)
ws.Rows(cell.Row).Cut
ws.Rows(2).Insert Shift:=xlDown
End If
End If
Next cell
Application.EnableEvents = True ' Re-enable events
Application.ScreenUpdating = True ' Re-enable screen updating
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Define constants.
Const TOP_TARGET_CELL_ADDRESS As String = "C2"
Const TOP_STRING As String = "M"
Const BOTTOM_STRING As String = "N"
Const TOP_TO_START As Boolean = False
Const BOTTOM_TO_START As Boolean = False
' Exit if multiple cells.
If Target.Cells.CountLarge > 1 Then Exit Sub
' Reference the worksheet.
Dim ws As Worksheet: Set ws = Me
' Reference the whole range.
Dim srg As Range
With ws.UsedRange
Set srg = ws.Range("A1", .Cells(.Cells.CountLarge))
End With
' Reference the intersection between the whole range and target range.
Dim trg As Range
With ws.Range(TOP_TARGET_CELL_ADDRESS)
Set trg = Intersect(.Resize(ws.Rows.Count - .Row + 1), srg)
End With
' Exit if the column of the target range is out of bounds.
If trg Is Nothing Then Exit Sub
' Reference the target cell.
Dim tcell As Range: Set tcell = Intersect(trg, Target)
' Exit if no intersection between the target range and the target cell.
If tcell Is Nothing Then Exit Sub
' Retrieve the new (changed) string.
Dim NewString As String: NewString = CStr(tcell.Value)
' Exit if it is neither.
If NewString <> TOP_STRING And NewString <> BOTTOM_STRING Then Exit Sub
' Start error-handling routine before disabling events
' to ensure they get reenabled.
Dim ErrorMessage As String, WasError As Boolean
On Error GoTo ClearError
Application.EnableEvents = False
' Retrieve the old (initial) string.
Application.Undo
Dim OldString As String: OldString = CStr(tcell.Value)
' Exit (enabling events) if it isn't any required string,
' or is equal to the new string.
If OldString <> TOP_STRING And OldString <> BOTTOM_STRING Then
tcell.Value = NewString ' rewrite
GoTo ProcExit
End If
If OldString = NewString Then GoTo ProcExit
' Retrieve the row and column of the target cell.
Dim TargetRow As Long: TargetRow = tcell.Row
Dim TargetColumn As Long: TargetColumn = tcell.Column
' Reference the whole new (changed) row.
Dim trrg As Range: Set trrg = srg.Rows(TargetRow)
' Reference the insert (single-row) range.
Dim irrg As Range, InsertRow As Long
If NewString = TOP_STRING Then
If TOP_TO_START Then
InsertRow = trg.Row
Else
InsertRow = trg.Rows(Application.Match(BOTTOM_STRING, trg, 0)).Row
End If
With srg.Rows(InsertRow)
.Insert xlShiftDown
Set irrg = .Offset(-1)
End With
Else ' NewString = BOTTOM_STRING
If BOTTOM_TO_START Then
InsertRow = trg.Rows(Application.Match(BOTTOM_STRING, trg, 0)).Row
With srg.Rows(InsertRow)
.Insert xlShiftDown
Set irrg = .Offset(-1)
End With
Else
Set irrg = srg.Rows(srg.Rows.Count).Offset(1)
End If
End If
' Copy, rewrite the new string, and delete.
trrg.Copy Destination:=irrg
irrg.Columns(TargetColumn).Value = NewString
trrg.Delete Shift:=xlShiftUp
ProcExit:
On Error Resume Next
Application.EnableEvents = True
If WasError Then MsgBox ErrorMessage, vbCritical
On Error GoTo 0
Exit Sub
ClearError:
ErrorMessage = "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
& Err.Description
WasError = True
Resume ProcExit
End Sub
额外
' Have this close when developing code that disables events.
Sub EnableEvents()
Debug.Print "Events had " _
& IIf(Application.EnableEvents, "already", "not") & " been enabled."
Application.EnableEvents = True
End Sub