让用户使用VBA单击单元格作为Excel输入框的输入 [英] Let the user click on the cells as their input for an Excel InputBox using VBA
问题描述
例如，输入框弹出，并询问用户你想从哪里开始？然后，用户将输入A4或者他们想要启动的单元格。
我的问题是，有没有办法让用户物理地点击单元格A4而不是打字？
提前感谢任何帮助
更新：所以，基本上我们有长度横跨数据的长列表。我们希望这些列表水平地堆叠在一起，这是这个代码应该做的。
以前一切工作都很好，但用户必须手动输入单元格到InputBox中。输入框向用户询问他们想要开始剪切的位置，第二个框会向用户询问他们想要开始粘贴的位置。我会将这些输入值存储到字符串变量中，一切都像一个魅力一样。
从那时起，我希望用户能够在单元格上物理上点击，因为它可以很难看看它实际上是哪个行号。下面的代码被更新，以反映尝试用于允许用户点击单元格的更改。我添加了 Application.InputBox 方法，并将变量的声明更改为Range。
我一次加入该程序，以查看发生了什么，这是我发现的。之前，如果用户想从B4开始并粘贴到A16，它将选择B（B4：B15）的数据范围，将其剪切并粘贴到A16。然后，我有代码的方式，它将返回到B4用户输入点，并使用for循环来增加我的x变量，它将偏移到右边的下一列。所以，然后重复切割列C（C4：C15）的过程，并将其粘贴到A28（使用xldown），依此类推，以进行列。
当我进入当前的代码时，现在发生了什么，我的Range变量中没有看到任何记录的值。它切割B4：B15并将其粘贴到A16的第一步，但是当它运行下一个循环时，而不是在B4返回并进行偏移，它将从A16开始，然后偏移。它应该回到B4，用户选择的起始点，然后抵消。
对不起，对于长期的解释，但我希望这有助于清除
使用Application.InputBox的当前代码
Dim x As Integer
Dim strColumnStart As Range
Dim strColumnEnd As Range
On Error Resume Next
Application.DisplayAlerts = False
设置strColumnStart = Application.InputBox（要启动什么样的单元格，起始位置，请包括列字母和单元格，类型：= 8）
错误GoTo 0
设置strColumnEnd = Application.InputBox（您要在哪里粘贴单元格？，粘贴位置，请包括列字母和单元格数字，类型：= 8）
错误GoTo 0
Application.DisplayAlerts = True
如果strColumnStart =你想要什么样的单元格开始吗？或_
strColumnEnd =请包括列信和单元格号然后
退出子
Else
对于x = 0 To strColumnStart.CurrentRegion.Columns.Count
strColumnStart.Select
ActiveCell.Offset（0，x）。选择
如果ActiveCell.Value =空然后
GoTo消息
Else
范围（Selection，Selection.End（xlDown））。选择
Selection.Cut strColumnEnd.Select
ActiveCell.Offset（-2,0）.Select
ActiveCell.End（xlDown）.Select
ActiveCell.Offset（1，0）.Select
ActiveSheet.Paste
strColumnStart.Select
End If
Next x
End If
消息：
MsgBox（Finished）
strColumnEnd.Select
ActiveSheet.Columns（ActiveCell.Column）.EntireColumn。 AutoFit
Application.CutCopyMode = False
End Sub
来自： http://www.ozgrid.com/VBA/inputbox.htm
Sub RangeDataType（）
Dim rRange As Range
On Error Resume Next
Application.DisplayAlerts = False
设置rRange = Application.InputBox（提示：= _
请选择一个范围，鼠标为粗体。，_
标题：=SPECIFY RANGE，类型：= 8）
错误GoTo 0
Application.DisplayAlerts = True
如果rRange不是，然后
退出Sub
Else
rRange.Font.Bold = True
结束If
End Sub
更新了OP的要求：
Sub Test2（）
Dim x As Integer
Dim rngColumnStart As Range
Dim rngColumnEnd As Range
Dim rngCopy As Range
Dim numRows As Long，numCols As Long
O n错误恢复下一步
设置rngColumnStart = Application.InputBox（_
选择要开始的单元格，_
选择起始位置，类型：= 8）
如果rngColumnStart没有，然后退出Sub
设置rngColumnEnd = Application.InputBox（_
选择要将单元格粘贴到，_
选择粘贴位置，，类型：= 8）
出现错误GoTo 0
如果rngColumnEnd是Nothing然后退出Sub
设置rngColumnEnd = rngColumnEnd.Cells（1）'在选择> 1个单元格
设置rngCopy = rngColumnStart.CurrentRegion
numRows = rngCopy.Rows.Count
numCols = rngCopy.Columns.Count
对于x = 1到numCols
rngCopy.Columns（x）.Copy _
rngColumnEnd.Offset（（x - 1）* numRows，0）
下一个x
rngCopy.ClearContents
MsgBox（Finished）
r ngColumnEnd.EntireColumn.AutoFit
Application.CutCopyMode = False
End Sub
I have an InputBox that stores user input into a variable. The input the user is inputting is a cell number.
For example, the input box pops up and asks the user, "Where would you like to start?" The user would then type in A4, or whichever cell they would want to start.
My question is, is there a way to allow the user to physically click on cell A4 instead of typing it in?
Thanks in advance for any help
Update: So, basically we have long lists of transposed data that span horizontally. We want those lists to stacked on top of each other horizontally, which is what this code is supposed to do.
Everything worked fine before, but the user would to have to manually type in the cell number into the InputBox. The input box asks the user where they want to start cutting and the second box asks the user where they want to start pasting. I would store those input values into string variables and everything worked like a charm.
Since then, I wanted the user to be able to physically click on the cell since it can be difficult to look at which row number it actually is. The code below is updated to reflect the changes trying to be used to allow the user to click on the cell. I added the Application.InputBox method and changed my declarations of the variables to Range.
I stepped into the program one at a time to see what was going on and this is what I found. Before, if the User wanted to start at B4 and paste to A16, it would select the data range for B(B4:B15), cut it, and paste it to A16. Then, the way I had the code, it would go back to the B4 user input spot and using a for loop to increment my x variable, it would offset to the next column over to the right. So, it would then repeat the process of cutting column C(C4:C15) and paste it this time to A28(using xldown), and so on for proceeding columns.
What is happening now when I stepped into this current code is that I don't see any recorded values into my Range variables. It does the first step of cutting B4:B15 and pasting it to A16, but when it goes to run the next loop, instead of starting back at B4 and offsetting, it starts off on A16 and then offsets. It should be going back to B4, which the user selected as the starting spot, and then offsetting.
Sorry, for the long explanations, but I hope this helped to clear the situation up.
Current code using Application.InputBox
Dim x As Integer
Dim strColumnStart As Range
Dim strColumnEnd As Range
On Error Resume Next
Application.DisplayAlerts = False
Set strColumnStart = Application.InputBox("What cell would you like to start at?", "Starting position","Please include column letter and cell number", Type:=8)
On Error GoTo 0
Set strColumnEnd = Application.InputBox("Where would you like to paste the cells to?", "Pasting position", "Please include column letter and cell number", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If strColumnStart = "What cell would you like to start at?" Or _
strColumnEnd = "Please include column letter and cell number" Then
Exit Sub
Else
For x = 0 To strColumnStart.CurrentRegion.Columns.Count
strColumnStart.Select
ActiveCell.Offset(0, x).Select
If ActiveCell.Value = Empty Then
GoTo Message
Else
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut strColumnEnd.Select
ActiveCell.Offset(-2, 0).Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
strColumnStart.Select
End If
Next x
End If
Message:
MsgBox ("Finished")
strColumnEnd.Select
ActiveSheet.Columns(ActiveCell.Column).EntireColumn.AutoFit
Application.CutCopyMode = False
End Sub
From: http://www.ozgrid.com/VBA/inputbox.htm
Sub RangeDataType()
Dim rRange As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please select a range with your Mouse to be bolded.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rRange Is Nothing Then
Exit Sub
Else
rRange.Font.Bold = True
End If
End Sub
Updated with OP's requirements:
Sub Test2()
Dim x As Integer
Dim rngColumnStart As Range
Dim rngColumnEnd As Range
Dim rngCopy As Range
Dim numRows As Long, numCols As Long
On Error Resume Next
Set rngColumnStart = Application.InputBox( _
"Select the cell you'd like to start at", _
"Select starting position", , Type:=8)
If rngColumnStart Is Nothing Then Exit Sub
Set rngColumnEnd = Application.InputBox( _
"Select where you'd like to paste the cells to", _
"Select Pasting position", , Type:=8)
On Error GoTo 0
If rngColumnEnd Is Nothing Then Exit Sub
Set rngColumnEnd = rngColumnEnd.Cells(1) 'in case >1 cell was selected
Set rngCopy = rngColumnStart.CurrentRegion
numRows = rngCopy.Rows.Count
numCols = rngCopy.Columns.Count
For x = 1 To numCols
rngCopy.Columns(x).Copy _
rngColumnEnd.Offset((x - 1) * numRows, 0)
Next x
rngCopy.ClearContents
MsgBox ("Finished")
rngColumnEnd.EntireColumn.AutoFit
Application.CutCopyMode = False
End Sub
这篇关于让用户使用VBA单击单元格作为Excel输入框的输入的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
