让用户使用 VBA 单击单元格作为 Excel InputBox 的输入

Let the user click on the cells as their input for an Excel InputBox using VBA

提问by Leon

I have an InputBox that stores user input into a variable. The input the user is inputting is a cell number.

我有一个 InputBox 将用户输入存储到一个变量中。用户正在输入的输入是单元格编号。

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.

例如，弹出输入框并询问用户，“您想从哪里开始？” 然后用户将输入 A4 或他们想要开始的任何单元格。

My question is, is there a way to allow the user to physically click on cell A4 instead of typing it in?

我的问题是，有没有办法允许用户物理点击单元格 A4 而不是输入它？

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.

之前一切正常，但用户必须手动将单元格编号输入到 InputBox 中。输入框询问用户他们想从哪里开始剪切，第二个框询问用户他们想从哪里开始粘贴。我会将这些输入值存储到字符串变量中，一切都像魅力一样。

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.InputBoxmethod and changed my declarations of the variables to Range.

从那时起，我希望用户能够物理点击单元格，因为很难查看它实际上是哪个行号。下面的代码已更新以反映尝试用于允许用户单击单元格的更改。我添加了Application.InputBox方法并将我的变量声明更改为 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.

我一次一个地进入程序，看看发生了什么，这就是我发现的。之前，如果用户想从 B4 开始粘贴到 A16，它会选择 B(B4:B15) 的数据范围，将其剪切，然后粘贴到 A16。然后，按照我获得代码的方式，它会返回到 B4 用户输入点并使用 for 循环来增加我的 x 变量，它将偏移到右侧的下一列。因此，它将重复切割列 C(C4:C15) 并将其粘贴到 A28（使用 xldown）的过程，依此类推以进行列。

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.

当我进入这个当前代码时，现在发生的事情是我没有看到任何记录到我的 Range 变量中的值。它执行切割 B4:B15 并将其粘贴到 A16 的第一步，但是当它运行下一个循环时，它不是从 B4 开始并偏移，而是从 A16 开始然后偏移。它应该返回到用户选择作为起点的B4，然后进行偏移。

Sorry, for the long explanations, but I hope this helped to clear the situation up.

抱歉，对于冗长的解释，但我希望这有助于澄清情况。

Current code using Application.InputBox

使用 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

回答by Tim Williams

From: http://www.ozgrid.com/VBA/inputbox.htm

来自：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:

更新了 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


     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