vba 如何在 Excel 中实现可重置、可覆盖的默认单元格值？

Question

提问by Iakovosian

>> Question summary

>> 问题总结

I want to implement a resettable, over-ridable, default cell value in Excel. By this, I mean to have a cell that reverts to a 'default' value, obtained by a lookup formula dependant on a second cell, when that second cell updates. There is also an option for the user to write a different value into the original cell, which would remain until the second cell is next updated.

我想在 Excel 中实现一个可重置、可覆盖的默认单元格值。这样，我的意思是让一个单元格恢复到“默认”值，当第二个单元格更新时，该值通过依赖于第二个单元格的查找公式获得。用户还可以选择将不同的值写入原始单元格，该值将一直保留到下一次更新第二个单元格。

>> Main body & Details

>> 主体及细节

Okay, so here's the situation; this snapshot is of the relevant area of a multiple worksheet data repository. The two cells of interest are highlighted green for clarity, and the highest visible row is row 1.

好的，情况就是这样；此快照属于多工作表数据存储库的相关区域。为清楚起见，两个感兴趣的单元格以绿色突出显示，最高可见行是第 1 行。

The Item Searchcell accepts a variety of word or phrase inputs, and has data validation to ensure only valid inputs are possible. The data validation is taken from an alphabetised list of possible inputs, and the cell has a drop-down list option (hence the little arrow to its right).
The Stackcell uses the input from the Item Searchcell in the following formula...
```
=IF(COUNTIF(C3:F315,J6),VLOOKUP(J6,C3:F315,4,FALSE),"~")
```
...where J6 is the Item Searchcell, and the range C3:F315 is the relevant part of a lookup table on the same sheet.

本项搜索细胞接受各种各样的词或短语的输入，并具有数据验证，以确保只有有效的输入是可能的。数据验证取自按字母顺序排列的可能输入列表，并且单元格有一个下拉列表选项（因此右侧的小箭头）。
该堆栈单元使用输入从项搜索以下公式单元格...
```
=IF(COUNTIF(C3:F315,J6),VLOOKUP(J6,C3:F315,4,FALSE),"~")
```
...其中 J6 是项目搜索单元格，范围 C3:F315 是同一工作表上查找表的相关部分。

Now, this is what I would like to happen in the Stackcell...

现在，这就是我希望在Stack单元格中发生的事情......

Current functionality:
- When an invalid input is entered into the Item Searchcell, a tilde is displayed instead of a number.
- When a valid input is entered, the relevant number from the lookup table is displayed in the cell. The Buyand Sellcells are also updated in the same fashion.
Desired additional functionality:
- In the first instance, the tilde cannot be overwritten.
- In the second instance, the 'default' number can be overwritten by inputting another number into the Stackcell.
- When a new input is entered (or just the same input again) into the Item Searchcell, the default number (or the tilde) is then displayed again.
Wish list (non-essential):
- To have a check-box (or similar; such as a yes/no input in an adjacent cell) that, if ticked, means that the displayed number in the Stackcell will not be changed/affected by any new 'default value' being read in from the lookup table. The number can still be modified by manually entering a new one.
- The Item Searchcell currently has a drop-down alphabetised list of all its possible valid data inputs. Is there a way to use this same list to add an auto-complete functionality to the cell? Perhaps a bit like the Google search engine, the drop-down list appears as you type and the items populating that list are continuously limited to those containing the (sub)string that you have so far typed.

当前功能：
- 当在“项目搜索”单元格中输入无效输入时，将显示波浪号而不是数字。
- 输入有效输入后，查找表中的相关数字将显示在单元格中。在购买和销售的细胞也被更新以同样的方式。
所需的附加功能：
- 首先，波浪号不能被覆盖。
- 在第二种情况下，可以通过将另一个数字输入到堆栈单元来覆盖“默认”数字。
- 当新输入（或再次输入相同的输入）到“项目搜索”单元格时，默认数字（或波浪号）将再次显示。
愿望清单（非必要）：
- 有一个复选框（或类似的；例如相邻单元格中的是/否输入），如果勾选，意味着堆栈单元格中显示的数字不会被任何新的“默认值”更改/影响从查找表中读入。该号码仍可通过手动输入新号码进行修改。
- “项目搜索”单元格当前具有所有可能的有效数据输入的按字母顺序排列的下拉列表。有没有办法使用相同的列表向单元格添加自动完成功能？可能有点像 Google 搜索引擎，下拉列表会在您键入时出现，并且填充该列表的项目一直限于包含您迄今为止键入的（子）字符串的项目。

NB: Whatever value is displayed in the Stackcell must be readable by formulae in other cells; namely the Buyand Sellcells, whose values would become a ratio of the Stackcell's lookup value and that being displayed in the cell at the time.

注意：堆栈单元格中显示的任何值都必须可由其他单元格中的公式读取；即买入和卖出单元格，其值将成为堆栈单元格的查找值与当时在单元格中显示的值的比率。

Is this possible to any degree? Preferably (but not exclusively) without needing the use of macros. This workbook is intended to be distributed to other people, with much of it being locked and protected to avoid any changes to the core data.

这在任何程度上都可能吗？最好（但不是唯一）不需要使用宏。该工作簿旨在分发给其他人，其中大部分内容已被锁定和保护，以避免对核心数据进行任何更改。

Thank you in advance.

先感谢您。

Information found so far:

目前查到的资料：

...but not quite fully resolving my question.

...但还没有完全解决我的问题。

I could probably use more than one cell to achieve the same (or similar) effective functionality (one cell holds the default value, another holds a possible user inputted value, and a third holds the relevant output value), but this would not look as good nor be as intuitive to the end user. This workbook is intended to be distributed to other people with much of it being locked and protected. --This answer is not desirable.
In my internet searchings before asking this question, I turned up this little bit of information. It said that if I wanted the reversion to the default value to be automatic, then use the following code in the worksheet change event routine:
```
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C2")) Is Nothing Then
        If Range("C2").Value = "" Then
            Range("C2").Value = 1234
        End If
    End If
End Sub
```
However, I am not fully aware of what is meant by this nor how to do it.
--C2 is a nominal cell used in the other person's example.
Someone asked a (possibly) similar question and was provided with thisanswer to do with using custom number formats. Would a custom number format accept a formula such as the one currently used in the Stackcell?

我可能会使用多个单元格来实现相同（或相似）的有效功能（一个单元格保存默认值，另一个保存可能的用户输入值，第三个保存相关输出值），但这看起来不像对最终用户来说也很好也不是很直观。该工作簿旨在分发给其他人，其中大部分内容已被锁定和保护。——这个答案不可取。
在我提出这个问题之前的互联网搜索中，我发现了这一点信息。它说如果我希望自动恢复到默认值，那么在工作表更改事件例程中使用以下代码：
```
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C2")) Is Nothing Then
        If Range("C2").Value = "" Then
            Range("C2").Value = 1234
        End If
    End If
End Sub
```
但是，我并不完全清楚这意味着什么，也不知道如何去做。
-- C2 是其他人示例中使用的标称单元格。
有人问一个（可能）类似的问题，并得到了这个答案做使用自定义数字格式。自定义数字格式是否接受诸如堆栈单元格中当前使用的公式？

Document upload:

文件上传：

Current and Desired functionality included, Wish list items yet to come.
Item-inary (public).xlsm- (MediaFire)
18-Mar-2012, 07:40 UCT

包括当前和所需的功能，愿望清单项目尚未到来。
Item-inary (public).xlsm- (MediaFire)
18-Mar-2012, 07:40 UCT

Current and Desired functionality + "Wish list 1".
Item-inary (public).xlsm- (Mediafire)
20-Mar-2012, 19:50 UCT

当前和所需的功能 +“愿望清单 1”。
Item-inary (public).xlsm- (Mediafire)
20-Mar-2012, 19:50 UCT

>> EDIT #1:

>> 编辑 #1：

This is my code in its various sections so far:

到目前为止，这是我在各个部分中的代码：

In ThisWorkbook

在 ThisWorkbook

Public temp As Integer 'Used to contain Range("M6").Value once CheckBox5 is ticked
Public warn As Boolean 'True if CheckBox1 is ticked whilst (vVal = "~")

Private Sub Workbook_Open()
    warn = False 'Initialise to False
End Sub

In Sheet1 (Price List)

在 Sheet1 (Price List)

Private Sub CheckBox1_Click()
    If OLEObjects("CheckBox1").Object.Value = True Then
        If Range("M6").Value = "~" Then
            warn = True
        Else
            temp = Range("M6").Value
            warn = False
        End If
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal As Variant

    On Error GoTo Whoa

    vVal = Application.Evaluate("=IF(COUNTIF(C3:F315,J6),VLOOKUP(J6,C3:F315,4,FALSE),""~"")")

    '~~> If J6 has been changed, then continue. Otherwise skip.
    If Not Intersect(Target, Range("J6")) Is Nothing Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect ("012370asdf")

        If vVal = "~" Then
            Range("M6").Value = "~"
            Range("M6:M7").Locked = True
        Else
            '~~> Check if CheckBox5 is ticked.
            If OLEObjects("CheckBox5").Object.Value = True Then
                '~~> Checks if CheckBox5 was ticked whilst (vVal = "~")
                If warn = True Then
                    temp = vVal
                    warn = False 'Reset warn status now that special case is resolved
                End If
                Range("M6").Value = temp
            Else
                Range("M6").Value = vVal
            End If
            Range("M6:M7").Locked = False
        End If

        ActiveSheet.Protect ("012370asdf")
        GoTo LetsContinue
    End If

    '~~> If M6 has been changed, then continue. Otherwise skip.
    If Not Intersect(Target, Range("M6")) Is Nothing Then
        Application.EnableEvents = False

        If OLEObjects("CheckBox5").Object.Value = True Then
            temp = Range("M6").Value
        End If

        GoTo LetsContinue
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox err.Description
    Resume LetsContinue
End Sub

This code does not yet include any 'Wish list 2'functionality, but otherwise works fine.

此代码尚不包含任何“愿望清单 2”功能，但其他方面工作正常。

A big thank you to those who helped.

非常感谢那些提供帮助的人。

Answer 1

采纳答案by Siddharth Rout

@SiddharthRout: I will still upload a current copy of the file for your perusal. Parts of my question have been answered, but there are still the two items from my 'Wish list' to be done with yet! –

@SiddharthRout：我仍然会上传文件的当前副本供您阅读。我的部分问题已得到解答，但我的“愿望清单”中还有两项尚未完成！——

As per my earlier suggestion, the current code that you are using should be written as

根据我之前的建议，您当前使用的代码应该写成

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    If Not Intersect(Target, Range("J6")) Is Nothing Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect ("012370asdf")
        If Application.Evaluate("=IF(COUNTIF(C3:F315,J6),VLOOKUP(J6,C3:F315,4,FALSE),""~"")") = "~" Then
            Range("M6").Value = "~"
            Range("M6:M7").Locked = True
        Else
            Range("M6").Formula = "=IF(COUNTIF(C3:F315,J6),VLOOKUP(J6,C3:F315,4,FALSE),""~"")"
            Range("M6:M7").Locked = False
        End If
        ActiveSheet.Protect ("012370asdf")
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

This also negates the use of an extra cell N6.

这也否定了额外单元格 N6 的使用。

I am looking at the rest of the stuff now and will update it soon.

我现在正在看其余的东西，很快就会更新。

UPDATE: Both your requests in the WishList are complete.

更新：您在愿望清单中的两个请求都已完成。

Your Worksheet_Changeevent now becomes this to incorporate Wish List 1 (See Snapshot attached)

您的Worksheet_Change活动现在变成了包含愿望清单 1 的活动（见附上的快照）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal As Variant

    On Error GoTo Whoa

    vVal = Application.Evaluate("=IF(COUNTIF(C3:F315,J6),VLOOKUP(J6,C3:F315,4,FALSE),""~"")")

    If Not Intersect(Target, Range("J6")) Is Nothing Then
        Application.EnableEvents = False

        ActiveSheet.Unprotect ("012370asdf")

        '~~> Check the value of the CheckBox and update cells only if false
        '~~> This is valid for "~" as well i.e if the checkbox is Checked then
        '~~> even "~" remain unchanged. If you don't want this, then move the 
        '~~> below condition inside "ELSE" part :)
        If OLEObjects("Checkbox1").Object.Value = False Then
            If vVal = "~" Then
                Range("M6").Value = "~"
                Range("M6:M7").Locked = True
            Else
                Range("M6").Value = vVal
                Range("M6:M7").Locked = False
            End If
        End If

        ActiveSheet.Protect ("012370asdf")
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

For your 2nd Wish List I had two options. I went ahead with the 2nd option.

对于您的第二个愿望清单，我有两个选择。我继续第二个选项。

1)Use the method as described in www.ozgrid.com

1)使用 www.ozgrid.com 中描述的方法

Topic: Auto Complete Typing in an Excel Data Validation List

主题：在 Excel 数据验证列表中自动完成键入

Link: http://www.ozgrid.com/Excel/autocomplete-validation.htm

链接：http: //www.ozgrid.com/Excel/autocomplete-validation.htm

And

和

2)Use a control instead of DV List. For this, I made these changes in the list

2)使用控件而不是 DV 列表。为此，我在列表中进行了这些更改

Remove Data validation in Cell J6
Gave a "Name" to your list X3:X315 from Name Manager. I called it "List"
Placed a ComboBox on top of Cell J6 and set the .ListFillRangeto the above "List" in design mode
Added the below code to the worksheet code area

删除单元格 J6 中的数据验证
从Name Manager为您的列表 X3:X315 指定一个“名称” 。我叫它“清单”
在 Cell J6 顶部放置一个 ComboBox 并.ListFillRange在设计模式中将其设置为上面的“列表”
将以下代码添加到工作表代码区域

CODE

代码

Private Sub ComboBox1_Click()
    Range("J6").Value = ComboBox1.Value
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
    If KeyCode = 13 Then
        Range("J6").Value = ComboBox1.Value
    End If
End Sub`

Now your ComboBox will auto-complete whenever you type anything in the box.

现在，只要您在框中键入任何内容，您的 ComboBox 就会自动完成。

SNAPSHOT

快照

enter image description here

SAMPLE FILE LINK (This link is active for 7 days)

样本文件链接（此链接有效 7 天）

Sample File

示例文件

HTH

Sid

锡德

Answer 2

回答by lnafziger

I'm not at my PC right now, so I can't test this but here is what you need to do:

我现在不在我的电脑旁，所以我无法测试这个，但这是你需要做的：

Number 2 in your "Information found so far" is the right direction to go, even though you said that you didn't want macros.

“到目前为止找到的信息”中的第 2 项是正确的方向，即使您说您不想要宏。

Move your formula for the Stackcell into another cell that isn't being used. Lock this cell, and set the background and text colors to be the same (so that it is "hidden"). For now, let's say that this is in O6. (Or just have this cell on another sheet that they can not access. I often have a hidden sheet just for these.)

将Stack单元格的公式移动到另一个未使用的单元格中。锁定此单元格，并将背景和文本颜色设置为相同（以便“隐藏”）。现在，让我们说这是在 O6 中。（或者只是将这个单元格放在另一个他们无法访问的工作表上。我经常有一个隐藏的工作表专门用于这些工作表。）

Right-click on the worksheet tab, and select View Code. In the new window, double-click the worksheet name that you want this code to run on.

右键单击工作表选项卡，然后选择View Code。在新窗口中，双击要运行此代码的工作表名称。

Private Sub Worksheet_Change(ByVal Target As Range)should be the default function that appears (and it will be empty).

Private Sub Worksheet_Change(ByVal Target As Range)应该是出现的默认函数（它将是空的）。

Place the following code into the Worksheet_Change routine:

将以下代码放入 Worksheet_Change 例程中：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Intersect(Range("J6"), Target)

    'If J6 has not been changed, then exit.  Otherwise continue.
    If rng Is Nothing Then
        Exit Sub
    Else
        'Replace password with the password that you use to protect the sheet (two places)
        ActiveSheet.Unprotect ("password")
        If Range("O6").Value = "~" Then
            Range("M6").Value = "~"
            Range("M6:M7").Locked = True
        Else
            Range("M6").Value = Range("O6").Value
            'Use M6:M7 here instead of just M6 because cells are merged.
            Range("M6:M7").Locked = False
        End If 
        ActiveSheet.Protect ("password")
    End If
End Sub

vba 如何在 Excel 中实现可重置、可覆盖的默认单元格值？

提问by Iakovosian

>> Question summary

>> 问题总结

>> Main body & Details

>> 主体及细节

Information found so far:

目前查到的资料：

Document upload:

文件上传：

>> EDIT #1:

>> 编辑 #1：

采纳答案by Siddharth Rout

回答by lnafziger

相关推荐

最近更新

标签

vba 如何在 Excel 中实现可重置、可覆盖的默认单元格值？

提问by Iakovosian

>> Question summary

>> 问题总结

>> Main body & Details

>> 主体及细节

Information found so far:

目前查到的资料：

Document upload:

文件上传：

>> EDIT #1:

>> 编辑 #1：

采纳答案by Siddharth Rout

回答by lnafziger

相关推荐

vba 等效于“Dim As String * 1” VB6 到 VB.NET

Excel VBA：中断代码执行（不是通过点击“转义”）

VBA 打印和写入命令混淆

vba 将列从一个 Excel 工作表复制到另一个，跳过之间的列

相关推荐

最近更新

标签