如果下拉列表中的选择发生更改，则从工作表中删除数据

跟进之前回答的问题：Excel VBA - 基于一系列下拉列表运行宏 https://stackoverflow.com/questions/40478350/excel-vba-run-a-macro-based-on-a-range-of-dropdown-lists.

当前：这是个人费用电子表格，我在我的表上使用 G 列Master用于对从我的信用合作社提供的 .csv 导入的行项目费用进行分类的工作表。 G 列中的每个单元格都有一个下拉列表，它是我的工作簿中其他工作表的名称：Power, Gas, Groceries等。目前，当您从 G 列下拉列表中进行选择时，它会复制A1:F1当前行的并将其粘贴到所选工作表的下一个空行，例如Power or Gas or Groceries。所有这一切终于工作正常了。

问题：但是，如果我重新分类线路费用，例如从我最初的选择Gas我把它改为Power它会再次复制A1:F1当前行并移动到Power工作表。这很棒，但我需要它来删除我们从我们的Gas tab.

可能的解决方案？：我能想到的唯一方法是添加类似的内容...如果下拉列表不为空并且我更改了原始选择，那么我需要找到以下内容的精确文本副本A1:F1（A1：日期，B1：编号，C1：描述，D1：借方，E1：贷方，F1：注释 - 这些将（“应该”）永远不会重复）来自原始选择工作表（Gas）并删除这些单元格并向上移动下面的行。我正在寻求帮助，请有人用代码编写上述场景，并向我展示它在我当前的代码中的样子（我对 VBA 的理解最多只是新手水平）。

这是我当前的代码，在更改下拉值后运行：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("G2:G1001"))
If Not rng Is Nothing Then
    For Each c In rng.Cells
        Select Case c.Value
            Case "Power": Power c
            Case "Gas": Gas c
            Case "Water": Water c
            Case "Groceries, etc.": GroceriesEtc c
            Case "Eating Out": EatingOut c
            Case "Amazon": Amazon c
            Case "Home": Home c
            Case "Entertainment": Entertainment c
            Case "Auto": Auto c
            Case "Medical": Medical c
            Case "Dental": Dental c
            Case "Income": Income c
            Case "Other": Other c
        End Select
    Next c
End If
End Sub

这是从上面的代码中触发的 case 宏（每种情况都有一个类似的宏）：

Sub Gas(c As Range)

Dim rng As Range

Set rng = c.EntireRow.Range("A1:F1") '<< A1:F1 here is *relative to c.EntireRow*

'copy the values
With Worksheets("Gas").Cells(Rows.Count, 1).End(xlUp)
    .Offset(1, 0).Resize(1, rng.Cells.Count).Value = rng.Value
End With

End Sub

有什么建议么？

尝试这个。您可能需要稍微调整一下，但它应该可以帮助您前进。我添加了一个全局变量，您可以存储下拉列表中的先前值。
In the SelectionChange我尝试创建错误处理来处理选定的多个单元格。如果仅选择 1 个单元格，则该值将绑定到全局变量。然后，您可以使用该变量在下拉列表中查找上一个值的工作表，循环遍历该工作表，然后删除该值。

首先，我已将其添加到您的天然气、电力等子项目中。使它们充满活力。

Sub Power(c As Range)

    Dim rng As Range

    Set rng = Nothing
    Set rng = Range("A" & c.Row & ":F" & c.Row) '<< A1:F1 here is *relative to c.EntireRow*

    'copy the values
    With Worksheets("Power").Cells(Rows.Count, 1).End(xlUp)
        .Offset(1, 0).Resize(1, rng.Cells.Count).Value = rng.Value

        ' Copy formating from Master Sheet
        With Worksheets("Master")
            Range("A" & c.Row & ":F" & c.Row).Copy
        End With
        .Offset(1, 0).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False

    End With

End Sub

在主表（不是模块）下，我添加了以下内容：

' Add this to the absolute top of the sheet, must be outside a procedure (sub)
Option Explicit
Public cbxOldVal As String
Dim PrevVal As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Rows.Count > 1 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub

cbxOldVal = Target.Value
End Sub

Private Sub Worksheet_Activate()
    If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
        PrevVal = Selection.Value
    Else
        PrevVal = Selection
    End If
End Sub

将其添加到您的Worksheet_Change事件。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Intersect(Target, Range("G2:G1001"))

If Not Intersect(Target, Columns("G")) Is Nothing Then
    If PrevVal <> "" Or cbxOldVal <> "" Then
        If cbxOldVal = Target.Value Then
            MsgBox "You have to click on another cell " & vbNewLine & "and then click back on " & Target.Address & " to change the value", vbExclamation, "Error"
            Cells(Target.Row, Target.Column) = PrevVal
            Exit Sub
        ElseIf Target.Value = "" Or Target.Value = PrevVal Then Exit Sub
        End If
    End If
End If

If Not rng Is Nothing Then
' Your loop

然后我添加了一些代码到你的Worksheet_Change事件。将其添加到之后End Select.

    If cbxOldVal = "" Then
    ' do nothing

    Else

        With Worksheets(cbxOldVal)

            Dim i As Integer
            Dim strFindA As String, strFindB As String, strFindC As String
            Dim strFindD As String, strFindE As String, strFindF As String
            strFindA = Sheets("Master").Range("A" & c.Row)
            strFindB = Sheets("Master").Range("B" & c.Row)
            strFindC = Sheets("Master").Range("C" & c.Row)
            strFindD = Sheets("Master").Range("D" & c.Row)
            strFindE = Sheets("Master").Range("E" & c.Row)
            strFindF = Sheets("Master").Range("F" & c.Row)

            For i = 1 To 100    ' replace with lastrow

            If .Cells(i, 1).Value = strFindA _
            And .Cells(i, 2).Value = strFindB _
            And .Cells(i, 3).Value = strFindC _
            And .Cells(i, 4).Value = strFindD _
            And .Cells(i, 5).Value = strFindE _
            And .Cells(i, 6).Value = strFindF _
            Then

            .Rows(i).EntireRow.Delete
            MsgBox "deleted row " & i
            GoTo skip:

            End If

            Next i


        End With
    End If
skip: