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

Question

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

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

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

提前感谢您的帮助

更新:所以，基本上我们有很长的水平跨越的转置数据列表。我们希望这些列表水平堆叠在一起，这就是这段代码应该做的。

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

从那时起，我希望用户能够物理地单击单元格，因为很难查看它实际上是哪个行号。下面的代码已更新以反射(reflect)试图用于允许用户单击单元格的更改。我添加了 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

 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

发件人: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