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

Question

我想将一些不连续的范围从几个工作簿/作品sheet复制到特定的sheet。我正在使用用户表单和 RefEdit 控件。但是每次我调用表单并寻址范围时 Excel 都会冻结！除了结束Excel，我什么也做不了！这是我的代码。

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = Range(Me.RefEdit1.Value)
rng.Copy
ThisWorkbook.Sheets("Transfer").Range("a1").PasteSpecial xlPasteValues
End Sub 

Private Sub UserForm_Activate()
For Each wb In Application.Workbooks
   ComboBox1.AddItem wb.Name
Next
ComboBox1 = ActiveWorkbook.Name
End Sub

Private Sub Combobox1_Change()
If ComboBox1 <> "" Then Application.Workbooks(ComboBox1.Text).Activate
End Sub

我的表单显示为无模式。

https://1drv.ms/u/s!ArGi1KRQ5iItga8CLrZr9JpB67dEUw

所以真的不确定我是否可以用这种方法复制。因为我无法测试我的表格。谢谢， M

Answer 1

无模式用户窗体中没有 RefEdit

问题是您不能使用包含 RefEdit 控件的无模式用户窗体。否则 Excel 失去对键盘焦点的控制，只能通过任务管理器或 Ctrl + Alt + Delete 终止。所以你必须显示你的 Userform modal （例如明确地 .Show vbModal 或没有这个默认参数）。

进一步提示：

不要在另一个控件中使用 RefEdit 控件，尤其是在 Frame 控件中，这可能会导致问题。

检查您是否获得有效范围（参见下面的 Helper 函数 getRng），然后您可以通过编码 ThisWorkbook.Sheets("Transfer").Range("A1") = Range(Me.RefEdit1.Value) 来分配新值使用 Copy 和 Paste。

对于非连续范围，SO 中有许多代码示例，但这不是Excel 冻结的原因。在下面的代码示例中，我假设您只想编写 one 单元格以工作 sheet 范围 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

Edit: treating non contiguous areas

按 Ctrl 键，您可以 select 非连续 范围，例如Sheet1!D12:E15,Sheet1!B7:C10 作为完全独立的区域（在 RefEdit 中用冒号分隔）。参考您的评论，我添加了以下示例如何通过变体数据字段数组（在下面的示例代码中称为 v）写回连续和非连续区域。据我了解，您总是希望从目标 sheet 中的单元格 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

Answer 2

感谢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

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

VBA- Using RefEdit for copying range between workbooks

excel

vba

range

userform