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

Question

我有一个InputBox，它将用户输入存储到一个变量中。用户输入的是一个单元格号码。

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

我的问题是，有没有一种方法可以让用户点击单元格A4而不是输入它?

提前感谢您的帮助

Update:所以，基本上我们有一长串的数据，它们是水平跨的。我们希望这些列表水平地堆叠在一起，这就是这段代码应该做的。

以前一切都很好，但是用户必须手动在InputBox中输入单元格号码。输入框询问用户想从哪里开始剪切，第二个框询问用户想从哪里开始粘贴。我将把这些输入值存储到字符串变量中，一切都很顺利。

从那时起，我希望用户能够物理地单击单元格，因为很难看到它实际是哪个行号。下面的代码已更新，以反映试图用于允许用户单击单元格的更改。我添加了应用程序。InputBox方法，并将变量声明更改为Range.

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

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

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

当前使用应用程序的代码。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

Answer 1

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

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