VBA-使用RefEdit复制工作簿之间的范围

无模式用户窗体中没有RefEdit

问题是你 无法使用无模式userform 包含 RefEdit 控制否则Excel将失去对键盘焦点的控制,只能通过任务管理器或Ctrl+Alt+Delete终止。所以你必须展示你的 用户表单 情态动词 (例如: .Show vbModal 或没有此默认参数)。

进一步提示:

不要使用 参照编辑 控制在另一个控制中,尤其是不在 Frame 控件,这可能会导致问题。

检查是否获得有效范围(请参阅 助手函数 getRng 然后您可以通过编码来分配新值 ThisWorkbook.Sheets("Transfer").Range("A1") = Range(Me.RefEdit1.Value) 而不是使用 Copy 和 Paste 。

对于 非连续范围 目前有许多代码示例,但这并不是Excel冻结的原因。在下面的代码示例中,我假设您想要编写 一 单元格仅适用于工作表范围 Target!A1 。

此外,我添加了一个布尔变量 bReady 为了锁定或解锁 Combobox1_Change() 事件并防止不必要的激活。

代码示例

Option Explicit         ' declaration head of UserForm Code module
Dim bReady As Boolean   ' boolean flag to show completion of workbook list

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = getRng(Me.RefEdit1.Value) ' << use helper function getRng
If Not rng Is Nothing Then
  'write only first cell back to cell Transfer!A1
   ThisWorkbook.Sheets("Transfer").Range("A1").Value = rng.Cells(1).Value
  'correct address to one cell only
   bReady = False
   RefEdit1.Value = rng.Parent.Name & "!" & rng.Cells(1).Address
   bReady = True
   RefEdit1.ControlTipText = "Value of " & RefEdit1.Value & " = " & Format(rng.Cells(1).Value, "General")
Else    ' after manual input of not existing ranges
   RefEdit1.Value = "": Me.RefEdit1.ControlTipText = "None": Beep
   RefEdit1.SetFocus
End If
End Sub

Private Sub UserForm_Activate()
Dim wb As Workbook
For Each wb In Application.Workbooks
    ComboBox1.AddItem wb.Name
Next
ComboBox1 = ActiveWorkbook.Name
bReady = True       ' allow workbooks activation in Combobox1_Change event
End Sub

Private Sub Combobox1_Change()
If Not bReady Then Exit Sub         ' avoids activation before completion of workbooks list
If ComboBox1 <> "" Then Application.Workbooks(ComboBox1.Text).Activate
End Sub

助手函数 getRng()

Function getRng(ByVal sRng As String) As Range
' Purpose: return valid range object or return Nothing
On Error Resume Next
Set getRng = Range(sRng)
If Err.Number <> 0 Then Err.Clear
End Function

编辑:处理非连续区域

按 Ctrl 您可以选择的键 非连续的 范围,例如。 Sheet1!D12:E15,Sheet1!B7:C10 作为完全独立的区域(在 参照编辑 )。参考您的评论,我添加了以下示例,说明如何通过变量数据字段数组(称为 v 在下面的示例代码中)。据我所知,您总是希望从目标工作表中的单元格A1开始:

Private Sub CommandButton1_Click()
Dim rng As Range, r As Range, v As Variant
Dim i As Long, n As Long
Dim iRowOffset As Long, temp As Long
Dim iColOffset As Long
Dim ws  As Worksheet
Set ws = ThisWorkbook.Worksheets("Transfer")
Set rng = getRng(Me.RefEdit1.Value) ' << use helper function getRng
If Not rng Is Nothing Then
  ' a) count (non) contiguous areas obtained via Ctrl-key in RefEdit (e.g. "D13:D15,A1:B2")
    n = rng.Areas.Count
  ' b) calculate necessary row/col offset to start copies at A1 in target sheet
    iRowOffset = rng.Areas(1).Row - 1
    iColOffset = rng.Areas(1).Column - 1
    For i = 1 To n
        temp = rng.Areas(i).Row - 1
        If temp < iRowOffset And temp > 0 Then iRowOffset = temp
        temp = rng.Areas(i).Column - 1
        If temp < iColOffset And temp > 0 Then iColOffset = temp
    Next i
  ' c) write values back
    For i = 1 To n
      With rng.Areas(i).Parent.Name ' sheet
         v = rng.Areas(i)           ' write values to variant 1-based 2-dim array
         ws.Range(rng.Areas(i).Address).Offset(-iRowOffset, -iColOffset) = v
      End With
    Next i

Else    ' after manual input of not existing ranges
   RefEdit1.Value = "":  Beep
   RefEdit1.SetFocus
End If
End Sub

感谢T.M.的大力帮助。

通过改变他的密码,我得到了这个答案。另外,复制粘贴方法对我也很有效,但这不是一个好的做法。

总之,所有的信用都是T.M。

Private Sub btnCopy_Click()
Dim rng As Range, v As Variant
Dim i As Long, n As Long, colno As Long
Dim ws  As Worksheet
Set ws = ThisWorkbook.Worksheets("Transfer")
Set rng = getRng(Me.RefEdit1.Value) ' << use helper function getRng

If Not rng Is Nothing Then
    ws.UsedRange.Clear
  ' a) count (non) contiguous areas obtained via Ctrl-key in RefEdit (e.g. "D13:D15,A1:B2")
    n = rng.Areas.Count
  ' c) write values back
    For i = 1 To n
         v = rng.Areas(i)           ' write values to variant 1-based 2-dim array
         colno = IIf(ws.Cells(1, 1) = "", 1, ws.Range("xfd1").End(xlToLeft).Column + 1)       ' FINDS THE LAST EMPTY COLUMN
         ws.Cells(1, colno).Resize(rng.Areas(i).Rows.Count, rng.Areas(i).Columns.Count) = v
    Next i

Else    ' after manual input of not existing ranges
   RefEdit1.Value = "":  Beep
   RefEdit1.SetFocus
End If
End Sub