使用鼠标提高速度来改变Excell单元格的值 [英] Increase speed of changing Excell cell's value with just a mouse
问题描述
我想增加使用鼠标更改Excel单元格值的速度。我分享我的工具,希望有人会喜欢它,并希望改善它。
I would like to increase the speed of changing Excel cell's value with a mouse only. I share my tool in hope that someone will like it and want to improve it.
这是一个例子。单击包含值的定义单元格后,滚动条将显示在单元格的右侧。您可以使用鼠标轻松更改其值。
This is an example. After clicking on a defined cell containing value, scrollbar appears on the right side of a cell. You can smoothly change its value with a mouse.
该工具旨在更改单元格值并动态观察公式值。您可以简化代码,但不应禁用某些功能。它应该始终保持动态,那就是移动滑板应该马上影响其他细胞配方。摇滚乐不应该闪烁(改变颜色灰色和黑色)。
The tool is meant to change cells value and observe formulas values dynamically. You may simplify the code however some features should not be disabled. It should always stay dynamic, that is moving the srollbar should immediately influence other cells with formulas. The srollbar should not twinkle (changing colour grey and black).
您可以简单地下载 scrollbar.xlsm 文件,并查看其中的VBA代码。
You may simply download the scrollbar.xlsm file here and view the VBA code inside it.
或者,您可以将此代码放在您希望显示蛋糕的表格中。你的工作表的名称没关系。右键单击工作表的名称,然后单击查看代码
。这是地方:
Or you may put this code in your sheet where you want the scollbars to appear. The name of your sheet does not matter. Right click on the sheet's name and then click View Code
. This is the place:
在此插入代码:
Option Explicit
Dim previousRow, c
Const scrlName As String = "scrlSh" ' the name of the scrollbar
Private Sub scrlSh_GotFocus()
ActiveSheet.Range(ActiveSheet.OLEObjects(scrlName).TopLeftCell.Offset(0, -1).Address).Activate
End Sub
Private Sub scrlSh_Scroll()
Dim rngCell As Range
Set rngCell = Sheets("Param").Range(ActiveSheet.OLEObjects(scrlName).LinkedCell)
ActiveSheet.OLEObjects(scrlName).TopLeftCell.Offset(0, -1).Value = _
rngCell.Offset(0, 1).Value + (ActiveSheet.OLEObjects(scrlName).Object.Value * rngCell.Offset(0, 3).Value)
Set rngCell = Nothing
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Macro concept by Przemyslaw Remin, VBA code written by Jaroslaw Smolinski
' The Sub Worksheet_SelectionChange and function SearchAdr have to be on each sheet where scrollbars are to appear
' Sheet Param is one for all sheets, only the columns A-G are used, othre columns can be used for something else
' Do not change the layout of A-G columns unless you want to modify the code
' Addresses in Param have to be with dollars (i.e. $A$3) or it may be named ranges of single cells
' (if it starts with $ it is a cell, otherwise it is a named range)
' the lower or upper case in addresses does not matter
Dim SheetFly As String, adr As String
Dim cCell As Range
Dim actSheet As Worksheet
Dim shScroll As Object
Set actSheet = ActiveSheet
' checks if scrollbar exists
If actSheet.Shapes.Count > 0 Then
For Each shScroll In actSheet.Shapes
If shScroll.Type = msoOLEControlObject And shScroll.Name = scrlName Then
Exit For ' scrollbar found, and the variable is set
End If
Next shScroll
End If
' if scrollbar does not exists then it is created
If shScroll Is Nothing Then
Set shScroll = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ScrollBar.1", Link:=False, _
DisplayAsIcon:=False, Left:=0, Top:=0, Width:=64 * 3, Height:=15)
' scrollbar length is set as three adjesent columns
shScroll.Visible = False
shScroll.Name = scrlName
shScroll.Placement = xlMoveAndSize
End If
shScroll.Visible = False
adr = Target.AddressLocal
SheetFly = actSheet.Name
' here we set up in which cells the scrollbar has to appear. We set up only the number of rows
Set cCell = SearchAdr(SheetFly, adr, Sheets("Param").Range("B2:B40")) ' If needed it can be longer i.e. B2:B400
If Not cCell Is Nothing Then
With ActiveSheet.OLEObjects(scrlName)
.LinkedCell = "" ' temporary turn off of the link to the cell to avoid stange behaviour
.Object.Min = 0 ' the scale begins from 0, not negative
.Object.Max = Abs((cCell.Offset(0, 4).Value - cCell.Offset(0, 3).Value) / cCell.Offset(0, 5).Value)
.Object.SmallChange = 10 ' single change by one step
.Object.LargeChange = 10 ' change by jumps after clicking on scrollbar bar ("page up", "page down")
If Target.Value <> cCell.Offset(0, 2).Value And Target.Value >= cCell.Offset(0, 3).Value And Target.Value <= cCell.Offset(0, 4).Value Then
' setting up the cells value as close as possible to the value of input by hand
' rounded by step
' if value is out of defined range then the last value will be used
cCell.Offset(0, 2).Value = Abs((Target.Value - cCell.Offset(0, 3).Value) / cCell.Offset(0, 5).Value)
End If
'Protection in case the value is out of min and max range
If cCell.Offset(0, 2).Value > .Object.Max Then
cCell.Offset(0, 2).Value = .Object.Max
ElseIf cCell.Offset(0, 2).Value < .Object.Min Then
cCell.Offset(0, 2).Value = .Object.Min
End If
Target.Value = cCell.Offset(0, 3).Value + (cCell.Offset(0, 5).Value * cCell.Offset(0, 2).Value)
.Object.Value = cCell.Offset(0, 2).Value
.LinkedCell = "Param!" & cCell.Offset(0, 2).Address 'setting up linked cell
End With
' Setting up the position and width of scrollbar with reference to the cell
shScroll.Top = Target.Top
shScroll.Left = Target.Offset(0, 1).Left + 2 'position to the right + small margin
shScroll.Width = Target.Offset(0, 5).Left - Target.Offset(0, 1).Left - 2 'width of 5 columns
shScroll.Visible = True
End If
Set actSheet = Nothing
Set shScroll = Nothing
Set cCell = Nothing
End Sub
Private Function SearchAdr(SheetFly As String, SearchCell As String, rng As Range) As Range
Dim cCell As Range
Dim oOOo As Name
' Searching for the row with parameter for chosen cell
' The parameter have to be in one, continouse range
For Each cCell In rng
If cCell.Text = "" Then ' check if parameters have not finished
Set SearchAdr = Nothing
Exit Function ' stop if you find first empty cell for speeding
ElseIf Left(cCell.Text, 1) = "$" Then ' normal address
If cCell.Offset(0, 1).Text & "!" & UCase(cCell.Text) = SheetFly & "!" & UCase(SearchCell) Then
Set SearchAdr = cCell
Exit Function ' exit if find proper row with parameters
End If
Else ' means that found is a name
For Each oOOo In ActiveWorkbook.Names
If (oOOo.RefersTo = "=" & SheetFly & "!" & UCase(SearchCell)) And (UCase(oOOo.Name) = UCase(cCell.Text)) Then
Set SearchAdr = cCell
Exit Function ' exit if find proper row with parameters
End If
Next oOOo
End If
Next cCell
End Function
在您的工作簿中,您必须制作名为 Param
其中存储滚动条的参数。在列A和C中,将您希望滚动条显示的表格的名称。该表格如下所示:
In your workbook you have to make sheet named Param
where the parameters of scrollbar are stored. In column A and C put the name of your sheet where you want scrollbars to appear. The sheet looks like this:
现在,您可以点击模型
表单中的单元格来享受滚动条。
Now you can enjoy the scrollbar after clicking the cell in the model
sheet.
请注意,您可以为每个单元格分别定义不同的最小,最大范围和滚动条的更改步骤。此外,最小和最大范围可以为负。
Note that you can define different min, max ranges and step of scrollbar change separately for every cell. Moreover, the min and max range can be negative.
推荐答案
我更喜欢:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
If OLEObjects.Count = 0 Then OLEObjects.Add "Forms.ScrollBar.1", , , , , , , Target.Offset(, 1).Left, Target.Top, 199, 15
With OLEObjects(1)
.Top = Target.Top
.object.max=200
Target = Application.Max(Target, .Object.Min)
Target = Application.Min(Target, .Object.Max)
.LinkedCell = Target.Address
End With
End Sub
这篇关于使用鼠标提高速度来改变Excell单元格的值的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!