Question

我想将一些不连续的范围从多个工作簿/工作表复制到特定的工作表。我正在使用userform和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

所以我真的不确定我是否可以使用此方法进行复制。因为我无法测试我的表格。谢谢，中号

Answer 1

无模式用户表单中没有RefEdit

问题是您无法使用包含RefEdit控件的无模式用户表单。否则Excel将无法控制键盘焦点，只能通过任务管理器或Ctrl + Alt + Delete终止。因此，您必须显示 Userform 模式（例如，明确地由.Show vbModal或没有此默认参数）。

进一步提示：

请勿在其他控件中使用RefEdit控件，尤其是Frame控件内的控件，这可能会导致问题。

检查您是否获得有效范围（请参阅下面的帮助函数getRng ），然后您只需编码ThisWorkbook.Sheets("Transfer").Range("A1") = Range(Me.RefEdit1.Value)而不是{{1}来分配新值}和Copy。

对于非contiguos范围，SO上有许多代码示例，但这不是Excel冻结的原因。在下面的代码示例中，我假设您只想将一个单元格写入工作表范围Paste。

此外，我添加了一个布尔变量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中的冒号分隔）。参考您的评论，我添加了以下示例，如何通过变量数据字段数组（在下面的示例代码中称为RefEdit）写回连续和非连续区域。据我所知，你总是希望从目标表中的单元格A1开始：

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复制工作簿之间的范围

2 个答案: