☰

通过鼠标左键单击并拖动获取 Excel VBA 应用程序.InputBox 范围 - 仅绑定到一列？

tag-icon • tag-icon microsoft-excel vba
通过鼠标左键单击并拖动获取 Excel VBA 应用程序.InputBox 范围 - 仅绑定到一列？

我已编辑此帖子以使其更清晰一些。

我有一段代码，提示用户通过鼠标左键单击并拖动来选择一个范围，然后将不同工作表上一个单元格的内容复制到该范围的每个单元格中。

我现在需要将宏绑定到 A 列，这样如果用户选择任何其他列中的任何范围或单元格，则宏将不会运行并显示错误消息，如“您选择了无效区域，请重试”，然后再次显示选择框，以便用户只能在 A 列中进行选择

Public Sub SelectRange()
  Dim aRange As Range
  Dim cel As Range
      
  On Error Resume Next
    Sheets("Sheet2").Select
    Columns("A2:A").Select
  Set aRange = Application.InputBox(prompt:="Enter range - Click And Drag To Select", Type:=8)
        aRange.Formula = "=Sheet1!A2"
    If aRange Is Nothing Then
        MsgBox "Operation Cancelled"
  Else
    aRange.Select
  End If
End Sub

答案1

你走在正确的道路上。但你需要决定是否要：

a）使用另一张表中的单元格中的值填充选定范围（如您在描述中所述），或者

b）将范围公式设置为观点到另一张表中的单元格（这就是您的代码正在执行的操作）

无论如何，您都可以使用以下内容。只需适当地注释/取消注释 Else 块中的相应代码即可。

Public Sub SelectRange()
    Dim aRange As Range
    Dim msgresult As Integer
    
    
TryAgain:
    On Error Resume Next 'go to the next line if the inputbox is nothing (X or Cancel)
    Set aRange = Application.InputBox(prompt:="Select a range of cells in column A", Type:=8, Title:="SuperUser")
    On Error GoTo 0 'resets the onerror action
    
    'if they haven't selected something
    'if they've selected more than one column
    'if they've selected any column other than the first column
    If aRange Is Nothing Or aRange.Columns.Count > 1 Or aRange.Column > 1 Then
      
        If MsgBox("You must only select cells in column A!" & vbCrLf & _
                "Do you want to try again?" _
                , vbYesNo _
                , "SuperUser") = vbYes Then
            GoTo TryAgain
        Else
            Exit Sub
        End If
                
    
    Else 'they selected a valid range
      
        aRange = Sheet2.Range("A2") 'fill the selected range with the value from this cell
        'OR:
        'aRange.Formula2 = "=Sheet2!$A$2" 'set the formula of the selected to point towards this cell
      
    End If
End Sub

答案2

尝试一下：

Public Sub SelectRange()
    Dim aRange As Range, s As String
    Dim Intersection As Range
    
    Sheets("Sheet2").Select
    On Error GoTo errr
    Set aRange = Application.InputBox(prompt:="Enter range - Click And Drag To Select", Type:=8)
    Set Intersection = Intersect(aRange, Range("A:A"))
    
    s = "=Sheet1!A2"
    
    If aRange Is Nothing Then
        MsgBox "Operation Cancelled"
        Exit Sub
    End If
    If Intersection Is Nothing Then
        MsgBox "Operation Cancelled"
        Exit Sub
    End If
    
    Intersection.Formula = s
    Exit Sub
errr:
    On Error GoTo 0
    MsgBox "Operation Cancelled"
    Exit Sub
End Sub

答案3

此宏限制用户只能从 A 列复制数据，如果选择错误，则提示并允许从 A 列重新选择数据，最后从特定工作表的单个单元格复制数据并粘贴到上一张工作表的 A 列中选定的范围内。

Public Sub SelectAndCopyRange()
   
Dim aRange As Range
   
OperationCancelled:
On Error Resume Next
   
   Set aRange = Application.InputBox(prompt:="Select from column A only ", Type:=8)
   
   If aRange Is Nothing Or aRange.Columns.Count > 1 Or aRange.column > 1 Then
   If MsgBox("Operation cancelled, Invalid selection!,," & vbCrLf & _
                "Like to select again?" _
                , vbYesNo _
                , "New Data Selection") = vbYes Then
                
            GoTo OperationCancelled
            Else
            Exit Sub
        End If
        
   Else
      
        aRange = MySheet.Range("A1")
   
   End If
  
  Application.CutCopyMode = False

End Sub

相关内容