在 Excel 中用一个单词替换相似的术语

在 Excel 中用一个单词替换相似的术语

我提前道歉,因为我不完全确定如何措辞这个问题。

我正在为一个学生组织保存财务记录,我的目标是制作一个易于使用的电子表格,以便可以在很多年后传承一种可靠的、最新的格式。

该组织内有多个职位,每个职位都有针对某些事项的预算。

现在,我已经设置了一个分类账,其设置如下:

预算 ----- 子预算 ---- 交易描述 ---- 金额
总裁 -- 领导 ----- 机票 -------------- $

使用下拉列表,用户可以输入文本,也可以从列表中选择。(我使用的是数据验证选项,选择了“列表”。)我不想限制非列表数据,因为我希望工作表易于使用。另一方面,我不想自由命名,因为标题相当长,我希望能够自动说明所有内容。

因此我认为好的中间立场是用类似的数据替换我想要的数据。

例如,用户可以在“预算”下输入:

  • 总统
  • 普雷斯
  • 反应性

我认识到所有这些都是指“总统”,所以我希望将输入替换为“总统”。

我知道我可以添加一个隐藏列,使用基本公式来解释这些内容,但我想添加一些可以自动执行此替换的内容;只要用户按下“Enter”,我希望电子表格自动将其更改为批准的术语。

同时,我希望为未涵盖的任何其他任期赋予默认更改值;任何不是总统任期或其他职位任期的值都归类为“其他”。

这可能吗?这需要 VBA 吗,还是此功能在现有设置下内置?

答案1

如果我理解正确的话,您希望用户在特定单元格中输入数据,一旦他们输入完毕,您希望更改同一单元格以满足一些经过清理的允许术语列表。

我知道更改单元格中数据的唯一方法是通过 VBA。您的选择是使用您提到的隐藏字段或使用 VBA。无论哪种方式,您都需要一个表格来显示所有非官方术语以及相应的官方术语。

其余方法取决于哪个更重要:易于实施或成品外观。例如,如果您能够打印并显示官方术语确实很重要,或者您想确保您的用户在其他地方看到他们输入的内容,那么辅助列可能无法正常工作,您必须使用 VBA。

如果您同意,请告诉我们,我们可以整理一个如何使其工作的示例。


编辑:楼主同意 VBA 解决方案

首先,设置如下:

  • 我有一个名为的隐藏工作表,WordTable其代号(在 VBA 中)是shtWordTable
  • 隐藏的工作表中有一个表格(如果你是老派的话,也可以是列表),其名称为tblWordTable
  • 该表有两个字段:NicknameProper Name
  • Nickname具有 Pres、P、pRez 等值(上帝保佑该用户)
  • Proper Name具有诸如 President、President 和 President 之类的值
  • 我有一个名为的可见工作表,Ledger其代号为shtLedger
  • 该工作表有一个名为tblLedger
  • 该表包含您在问题中提到的 4 个字段

请注意,如果您的数据不在正式表格中而只是一小块单元格,则该解决方案将有效,但我喜欢表格,它们对很多事情都很有用,所以我在示例中使用了表格。我会注释掉代码,这样你就可以知道要编辑哪些行。

使用该设置,进入 VBA 并可以Worksheet_Change在 内创建一个事件shtLedger。每次该工作表中的任何单元格中的数据发生变化时,都会触发该事件。我们会让它检查它是否在我们想要自动更正的范围内,如果是,则在 中寻找替代品WordTable。如果找到一个,我们会把它换掉。

对于您的具体情况,代码可能比需要的要长,但是,因为我不知道你的设置看起来就像这样,我试图让它尽可能地强大。还有一些评论部分只是为了提供帮助。你的最终结果应该比这短一点:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    'Declarations
    Dim tbl As ListObject
    Dim rngAutocorrect As Range
    Dim rngFound As Range
    Dim cell As Range

    'Setup what cells we want to check for nicknames
    'It will error if the table has no data in it because DataBodyRange will be nothing
    On Error Resume Next
        Set rngAutocorrect = ListObjects("tblLedger").ListColumns("Budget").DataBodyRange
    On Error GoTo 0

    'If it did error out so there is no data in the table so we exit
    If rngAutocorrect Is Nothing Then Exit Sub

    'If you're not using a table, you can do something like this:
    ' Set rngAutocorrect = Range("A:A")
    'The only important thing is that you end up with a range object

    'If there are multiple areas to check, one method is to use Union to add them
    'You can also define them all at once, but the Union method trades longer code for easier debugging
    ' Set rngAutocorrect = Union(rngAutocorrect, ListObjects(1).ListColumns("Sub-Budget").DataBodyRange)
    ' Set rngAutocorrect = Union(rngAutocorrect, Range("B:B"))

    'Check if what was changed (Target) is within the range we want to Autocorrect
    If Not Intersect(Target, rngAutocorrect) Is Nothing Then
        'Store the lookup table in an easy-to-reference format
        Set tbl = shtWordTable.ListObjects("tblWordTable")

        'Target might be a range of cells if, for instance, they have pasted a lot of text in
        'Loop through each in turn
        For Each cell In Target.Cells
            'Check that this particular cell needs autocorrecting
            If Not Intersect(Target, rngAutocorrect) Is Nothing Then
                'Look for the value in the word table
                With shtWordTable.ListObjects(1)
                    'Change the parameters here if you want to match case or something
                    Set rngFound = .ListColumns("Nickname").DataBodyRange.Find( _
                        cell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                    'If we found it, then grab the Proper Name
                    If Not rngFound Is Nothing Then
                        'Turn off events or else this code will trigger itself in an infinite loop
                        Application.EnableEvents = False

                        'Make the switch
                        cell.Value = rngFound.Offset(0, 1).Value

                        'Turn events back on
                        Application.EnableEvents = True
                    End If
                End With
            End If
        Next
    End If


    'Cleanup
    Set tbl = Nothing
    Set rngFound = Nothing
    Set rngAutocorrect = Nothing
    Set cell = Nothing

End Sub

相关内容