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

2024-01-27

跟进之前回答的问题: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:
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

如果下拉列表中的选择发生更改,则从工作表中删除数据 的相关文章

  • 根据当前工作簿中的匹配值编辑主工作簿中的单元格

    这里的目标是比较两个工作簿之间 A 列中的值 当前工作簿是 xlsm 目标工作簿是 xlsx 如果找到任何匹配项 匹配值同一行的 E 列中的值在目标工作簿中发生更改 在这种情况下 必须将工作簿分开 我决定通过选择当前工作簿 A2 中的第一个
  • Excel - 确定排列的奇偶性

    我正在处理一个 Excel 工作表 需要确定大小数字的垂直数组的奇偶校验N 该数组包含来自的每个数字1 to N每一次正好一次 在这种情况下 奇偶校验被定义为将加扰数组转换为从小到大排序的数组所需的交换次数 例如 数组 3 1 2 4 具有
  • 使用VBA复制垂直列并沿对角线粘贴

    我有一列数据 我们称之为 A 列 其中有 35 行数据 如何在此列上循环 然后将每个数据点粘贴到另一张工作表中 同时为每个循环循环增加列和行 换句话说 我寻求对角粘贴在第二张纸中 有没有一种简单的方法可以在 VBA 中执行此类操作 不要循环
  • 从网站上的表格中抓取数据,而无需搜索标签

    这是这个问题的延续使用 InStr 搜索引号 空格 冒号等 https stackoverflow com questions 52673819 using instr to search for quotes spaces colons
  • MS Access 表单按钮,允许用户浏览/选择文件,然后将文件导入到表中

    在我的数据库中 我可以使用以下命令创建命令按钮导入文件 DoCmd TransferText acImportDelim 导入的原始数据 导入规范 导入的原始数据 D Users Denise Griffith Documents Grif
  • 将最后几个功能添加到我的调度模板生成器中

    感谢 StackOverflow 上的一些出色的人 我几乎完成了调度模板生成器的代码 我还想补充三件事 但我遇到了一些麻烦 当前细分 我有两张表 2 员工列表 和 X 模板 员工列表中的值是从单元格 D9 开始的一列员工姓名 然后将员工值转
  • 无法在我的抓取工具中设置超时选项以防止无限循环

    我已经使用 IE 在 vba 中编写了一个脚本 在其搜索框中的网页中启动搜索 通过点击搜索按钮根据搜索填充结果 网页加载它是searchbox几秒钟后它就会打开 但是 我的下面的脚本可以处理这个障碍并以正确的方式执行搜索 现在 我有一个稍微
  • 如何在VBA编辑器中跳转到行号?

    我在 Office 2010 中使用 VBA 在顶部 有一个带有行号和列号的框 例如 Ln 1480 Col 17 有没有办法在代码编辑中 而不是在执行中 直接跳转到另一个行号 就像我使用的那样Ctrl G在记事本中 这个MSDN答案 ht
  • 合并和颜色样式不适用于 Apache POI excel 2003 格式

    在 Apache POI 中 我为某些单元格应用了一些样式并合并了这些单元格 当我在 2010 年或 2007 年打开时 它工作正常 但在 2003 年 格式样式消失了 每次保存 2003 Excel 文件之前都会弹出兼容性检查对话框 请参
  • VBA 中的多线程

    这里有人知道如何让VBA运行多线程吗 我正在使用 Excel 无法用 VBA 本地完成 VBA 构建在单线程单元中 获得多个线程的唯一方法是使用 VBA 之外的其他具有 COM 接口的东西构建 DLL 并从 VBA 调用它 信息 OLE 线
  • 在合并的单元格中选择、插入照片并将其居中

    我是一名研发面包师 正在为我的团队制作食谱模板 模板中有照片 但我需要轻松地允许他们单击一个按钮 打开照片的文件选择器 然后将该照片放在合并的单元格中 我其实不太擅长做这个 Sub InsertPhotoMacro Dim photoNam
  • VBA 有没有办法了解未使用的变量?

    标准 VBA 编辑器中是否有工具 方法或设置来警告已被修改的变量Dim med 但没有被使用 MZ Tools http www mztools com index aspx将搜索您的代码并告诉您哪些内容未被使用 VBA的版本可以找到her
  • SQL Server,插入 Excel“链接服务器”时出现“无效列名”错误

    我有一个简单的 Excel 电子表格文档 运行 Office 2013 我使用 Microsoft Office 15 0 Access 数据库引擎 OLE DB 提供程序 将其用作数据库 我可以使用 MS SQL Server Manag
  • 我可以获取VBA代码中的注释文本吗

    可以说我有以下内容 Public Sub Information TEST End Sub 有没有办法得到 TEST 结果 不知何故通过VBA 例如 在 PHP 中 有一个获取注释的好方法 这里有什么想法吗 编辑 应该有办法 因为像 MZ
  • VBA ByRef 参数类型不匹配

    最初在我的主代码部分中 我有一个丑陋的 if 语句 尽管它会运行丑陋 我决定将其设为我要调用的函数 这导致我收到错误 编译错误 ByRef 参数类型不匹配 我的假设是该函数需要正确引用 尽管我一直在阅读文档并且不明白为什么 gt 声明 Sh
  • Excel 数字缩写格式

    这是我想要完成的任务 Value Display 1 1 11 11 111 111 1111 1 11k 11111 11 11k 111111 111 11k 1111111 1 11M 11111111 11 11M 11111111
  • 如何在Power Query中对N列求和

    我的数据每月都会更新 因此我尝试创建一个强大的查询表 该表将显示我创建的枢转 N 列的总和 但我似乎不知道如何在强大的查询中执行此操作 我目前有这个代码 旋转后 创建要求和的列的列表 添加索引列以限制每行 添加一列 该列对该行的列进行求和
  • 标志状态的 VBA 替换

    根据文档 Outlook 中的 MailItem FlagStatus 属性是已弃用 https msdn microsoft com en us library microsoft office interop outlook maili
  • 我如何以更好的方式编码而不是像这样的VBA编码

    我正在 Excel 中创建一个仪表板 但是我想知道是否有比这更好的编码方式 我想对其进行模块化 而不是这样做以使其更加整洁 Private Sub Afford If af Value True Then af afr Value Shee
  • 在VBA中初始化全局变量

    在 Excel 2003 中 如何声明全局变量并仅在打开工作簿时初始化它们一次 我有一些由几个宏使用的参数 基本上是输入文件的路径 目前 我的代码如下所示 global path1 path2 as string sub initPaths

随机推荐

  • MySQL LIKE + php sprintf

    test sprintf SELECT FROM table WHERE text LIKE s mysql real escape string test echo test output SELECT FROM table WHERE
  • 从各种 JSON 路径创建 JSON 对象

    我们需要从提供的各种 JSONPaths 创建 JSON 对象 例如 下面是要创建的新 JSON 对象中的两个路径以及该路径的值 student firstName Abc student subject physics mark 100
  • 如何使用 flutter cloud_firestore 包传递 firestore 身份验证令牌

    我在用Firebase 身份验证 REST api进行身份验证 这部分工作正常 因为我可以登录 注册用户 并且我可以获得uid和授权token back 当尝试写入 Cloud Firestore 时 如果我将 Cloud Firestor
  • pytest 装置和 confest.py 模块可以跨包共享吗?

    假设我有packageA它提供了一个类usefulClass pytest 固定装置test stuff py模块 并测试配置conftest py模块 此外 假设我有packageBand packageC两者都导入packageA 通过
  • Azure Devops:如何使用 if 语句设置组变量

    我正在尝试根据管道中存在的一个变量来设置变量组 yaml 看起来像这样 但是当我运行管道时出现以下错误 如果我删除 组 QA or 组 PROD 管道运行没有任何问题 我究竟做错了什么 这是略有不同的解决方案 但您可以实现您的目标 如果我理
  • 在 Google App Engine 上使用 Python 进行开发时,应该使用什么模拟对象框架?

    我正在使用 Python 和 Django 如果有的话 在 Google App Engine 上开发一个应用程序 我应该帮助哪个模拟对象框架来协助单元测试 我看到有很多独立的项目 即http python mock sourceforge
  • 如何模拟返回 Task> 和 Task> 的方法?

    我正在尝试设置一个单元测试初始值设定项 以 Moq 形式 其中正在模拟接口方法 public interface IRepository Task
  • 管理实验中的多个任意逻辑模拟

    我们正在 AnyLogic 7 下开发 ABM 并且我们希望通过单个实验进行多个模拟 将为每次模拟运行设置不同的参数 以便为一小组标准场景生成结果 我们有一个无需按 运行 即可自动启动的实验 随后按下 运行 会增加实验计数器并重新运行模型
  • 为什么 Nettle 2.4 的 `configure` 找不到 GMP 5.0.2?

    我正在尝试建立GnuTLS http www gnu org software gnutls 在 Mac OS X 10 5 Leopard 服务器上 是的 我知道 它有点过时 但这就是该服务器目前正在运行的 并且遇到了构建问题Nettle
  • AngularJS 中的 ng-app V/S data-ng-app

    在AngularJS中使用时ng app ng app在文档中找到的将用于定义根元素以作为应用程序自动引导 在某些应用程序中 它被用作data ng app 以下两个声明是否有任何区别 如果是 则什么 如果否 则哪一个是重要的 为什么 1
  • Java线程睡眠与中断异常

    为什么睡眠线程需要 try catch 来捕获中断异常 为什么睡眠甚至会发出中断异常错误 这是我在java编程中真正想了解的两个问题 我一直在通过谷歌搜索 但仍然没有找到明确的解释来解释为什么会发生这两件事 An InterruptedEx
  • 无符号负基元?

    在 C 中我们可以创建原语unsigned 但他们总是积极的 还有一种方法可以生成无符号负变量吗 我知道 无符号 这个词的意思是 没有符号 所以也不是减号 但我认为C 必须提供它 No unsigned只能包含非负数 如果您需要一个仅表示负
  • 如何获取机器的mac地址

    我想要获取机器的 MAC 地址 但是下面编写的代码仅在 Internet 连接到我的机器时显示 MAC 地址 其他它将返回 null 我使用的是 Windows 7 import java net InetAddress import ja
  • 替换 hive 中的空字符串 - Nvl 和 COALESCE 已尝试

    如何用其他值替换空字符串 长度 0 已使用Nvl and COALESCE但两者都不会替换为替换值 因为该值不为空 我可以用case语句 但寻找内置函数 如果有 因为你有空字符串所以当我们使用合并或 nvl仅当我们有空值在数据中 这些功能不
  • 4.0 和 2.0 应用程序之间的 Asp.Net 表单身份验证 SSO

    4 0 框架应用程序和 2 0 框架应用程序之间的单点登录似乎已被破坏 我有一个基于 asp net Framework 2 0 构建的旧应用程序和一个基于 asp net Framework 4 0 构建的新应用程序 我正在尝试在两者之间
  • VS2010图表控件:减少Y轴边距

    如何减小如下所示的左侧边距区域 标记为红色 的宽度 尝试这样的事情 Chart ChartAreas Chart ChartArea ObjectName InnerPlotPosition New System Windows Forms
  • 我可以暂时暂停 ORMLite 中自动生成的 ID 吗?

    我在我目前正在编写的一个小应用程序中使用 Android 和 ORMLite 该应用程序的目标是具有有效的导入 导出功能 为此我使用简单的 XML 框架 在某种程度上 一切都运转良好 情况如下 对象 A 包含引用对象 B 的外键 对象 B
  • 有没有办法从字符串创建 SyndicateFeed?

    我正在尝试从本地存储的 XML 数据重新创建 SyndicateFeed 对象 System ServiceModel Syndicate 如果我使用 XMLDocument 这会很容易 我会调用 LoadXml string Syndic
  • 任意长度的通用位向量类型

    出于与此处描述相同的原因 用户定义的未解释函数 https stackoverflow com questions 7740556 equivalent of define fun in z3 api 我想定义我自己的未解释函数 bvred
  • 如果下拉列表中的选择发生更改,则从工作表中删除数据

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