主页 / computer / 问题 / 1562772
Accepted
Kenny
Asked: 2020-06-22 16:50:39 +0800 CST

通过鼠标左键单击并拖动获取 Excel VBA Application.InputBox Range - 仅绑定到一列？

  • 772

我已经编辑了这篇文章以使其更清晰。

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

我现在只需要将宏绑定到 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
microsoft-excel vba

3 个回答

  1. Best Answer

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

    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
    • 1

  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
    • 1

  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
    • 1

相关问题