Excel VBA - 如果从下拉列表中选择更改，则从工作表中删除数据 [英] Excel VBA - Delete Data from a Worksheet If Selection from Dropdown List is Changed

问题描述

跟进以前回答的问题： Excel VBA - 根据一系列下拉列表运行宏。

目前：这是个人费用电子表格，我正在使用我的硕士课程工作表中的列G来分类线从我的信用社提供的.csv导入的物品费用。列G中的每个单元格都有一个下拉列表，它是工作簿中其他工作表的名称： Power ， Gas ，杂货等。目前，当您从列G下拉列表中进行选择时，它将复制 A1：F1 的当前行并将其粘贴到任何工作表被选择的下一个空行，例如电力或气体或杂货。所有这一切终于工作正常了。

问题：但是，如果我重新分类行费用，例如从我原来的选择 Gas ，我将其更改为电源它将再次复制 A1：F1 当前行，并移动到电源工作表。这很棒，但是我需要它来删除我们从 Gas 标签中复制的行。

可能的解决方案？：我可以想到的唯一方法是添加这样的东西...如果下拉列表不是空白的，而且我需要更改原始选择（A1：日期，B1：否，C1：说明，D1：借记，E1：信用，F1：注意 - 这些）的确切文本副本 A1：F1 将从原始选择工作表（ Gas ）中将（应该）永远不会重复），并删除这些单元格并向上移动以下行。我要求帮助某人请在代码中写上述情况，并向我显示我目前的代码中的内容（我在新手级别了解VBA） -

以下是当前代码，一旦下拉列表值更改，就会运行：

  Private Sub Worksheet_Change（ByVal Target作为范围）
 Dim rng As Range，c As Range 
 Set rng = Intersect（Target，Range（G2：G1001））
如果没有rng是没有，然后
对于每个c在rng.Cells 
选择案例c.Value 
案例权力：权力c 
案例气体：气体c 
案例水：水c 
案例杂货等：GroceriesEtc c 
案例吃掉：EatOut c 
案例亚马逊：Amazon c 
案例Home：首页c 
案例娱乐：娱乐c 
案例自动：自动c 
病例医疗：医疗c 
病例牙科：牙科c 
案例收入：收入c 
案例其他：其他c 
结束选择
下一步c 
结束如果
结束Sub 
  

以上是从上述代码中消灭的大小写宏（每种情况都有类似的宏）：

  Sub Gas（c As Range）
 
 Dim rng As Range 
 
设置rng = c.EntireRow.Range（A1：F1）'<< A1：F1这里是*相对于c.EntireRow * 
 
'复制值
使用Worksheets（Gas）。单元格（Rows.Count，1）.End（xlUp）
 .Offset（1，0）.Resize（1，rng.Cells.Count）.Value = rng.Value 
 End with 
 
 End Sub 
 
解决方案
尝试这个。你可能需要调整一下，但它应该让你走。我添加了一个全局变量，您可以从下拉列表中存储以前的值。
 
在 SelectionChange 中，我尝试创建一个错误处理照顾多个选定的单元格。如果只选择1个单元格，则该值将被绑定到全局变量。然后，您可以使用该变量在下拉列表中查找先前值的表格，循环遍历表格，然后删除该值。
 
 
 
首先我将其添加到你的天然气，电力等等。让他们动态。
  Sub Power（c As Range）
 
 Dim rng As Range 
 
设置rng = Nothing 
设置rng =范围（A& c.Row&：F& c.Row）'< A1：F1这里是*相对于c.EntireRow * 
 
'复制值
使用Worksheets（Power）。单元格（Rows.Count，1）.End（xlUp）
 .Offset（1，0）.Resize（1，rng.Cells.Count）.Value = rng.Value 
 
'从主表复制表格
使用工作表（Master ）
范围（A& c.Row&：F& c.Row）.Copy 
结束与
 .Offset（1，0）.PasteSpecial xlPasteFormats 
 Application.CutCopyMode = False 
 
结束
 
 End Sub 
  
在主表（不是模块）下，我已经添加了：
 '将其添加到
选项显式
公共cbxOldVal As String 
 Dim PrevVal As Variant 
 
 Private Sub Worksheet_SelectionChange（ByVal目标为范围）
如果Target.Rows.Count> 1然后退出Sub 
如果Target.Columns.Count> 1然后退出Sub 
 
 cbxOldVal = Target.Value 
 End Sub 
 
 Private Sub Worksheet_Activate（）
如果Selection.Rows.Count = 1和选择.Columns.Count = 1然后
 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 =相交（目标，范围（G2：G1001））
 
如果不相交（目标，列（G））没有，然后
如果PrevVal& 或cbxOldVal 然后
如果cbxOldVal = Target.Value然后
 MsgBox你必须点击另一个单元格& vbNewLine& 然后点击& Target.Address& 更改值，vbExclamation，错误
单元格（Target.Row，Target.Column）= PrevVal 
退出子
 ElseIf Target.Value =或Target.Value = PrevVal然后退出Sub 
 End If 
 End If 
 End If 
 
如果不是rng不是然后
'你的循环
  
然后我添加了一些代码到你的 Worksheet_Change 事件。在 End Select 之后加入。 
 如果cbxOldVal =然后
'不做任何
 
 Else 
 
与工作表（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）
 
对于i = 1至100'替换为lastrow 
 
如果.Cells（i，1）.Value = strFindA _ 
 And .Cells（i，2）.Value = strFindB _ 
 And .Cells（i，3）.Value = strFindC _ 
和.Cells（i，4）.Value = strFindD _ 
 And .Cells（i，5）.Value = strFindE _ 
 And .Cells（i，6）.Value = strFindF _ 
然后
 
 .Rows（i）.EntireRow.Delete 
 MsgBoxdeleted row& i 
 GoTo跳过：
 
结束如果
 
下一步我
 
 
结束
结束如果
跳过：
  
 
Follow up question to a previously answered question: Excel VBA - Run a macro based on a range of dropdown lists. 

Current: This is for a personal expense spreadsheet and I am using Column G on my Master worksheet to classify line item expenses imported from a .csv provided by my credit union. Each cell in Column G has a dropdown list which is the name of the other worksheets in my workbook: Power, Gas, Groceries, etc. Currently, when you make a selection from the Column G dropdown list, it copies A1:F1 of the current row and pastes it to the next empty row of whatever worksheet was selected, e.g. Power or Gas or Groceries. All of that is finally working fine. 

Problem: However, if I re-classify a line expense, e.g. from my original selection Gas and I change it to Power it will again copy A1:F1 of the current row and move to the Power worksheet. That is great BUT I need it to remove the line we copied from our Gas tab. 

Possible Solution?: The only way I can think of this is adding something like this... IF the dropdown is not blank and I change the original selection THEN I need to find an exact text copy of A1:F1 (A1: Date, B1: No., C1: Description, D1: Debit, E1: Credit, F1: Notes - these will ("should") never be duplicate) from the original selection worksheet (Gas) and delete those cells and move up the below rows. I'm asking for help for someone to please write that above scenario in code and show me what it will look like in my current code (I understand VBA at a novice level - at best).

Here is my current code that runs once a dropdown value is changed: 
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
Here is the case macro that is fired off from the above code (there is a similar macro for each 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
Any Suggestions?
解决方案
Try this. You probably need to tweak it a bit, but it should get you going. I have added a global variable that you can store the previous value from the dropdown list.

In the SelectionChange I have tried to create an error handling to take care of multiple cells selected. If just 1 cell selected then that value will be bound to the global variable. Then you can use that variable to find the sheet of the previous value in the dropdown list, loop through the sheet, and delete the value.

First I have added this to your Gas, Power, etc. subs. to make them dynamic.
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
Under the Master sheet (not module), I have added this:
' 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
Add this to your Worksheet_Change event.  
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
Then I have added some code to your Worksheet_Change event. Add this to after the 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:


                        
这篇关于Excel VBA  - 如果从下拉列表中选择更改，则从工作表中删除数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！