VBA- Using RefEdit for copying range between workbooks

问题

I wanted to copy some not continous ranges from several workbook/ worksheets to a specific sheet. I am using a userform and RefEdit control on that. But the Excel freezs each time I am calling the form and addressing the ranges! I can't do anything except End Excel! Here is my Code.

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

My Form was showed modeless.

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

So really not sure I can copy with this method or not. As I was not able to test my form. Thanks, M

回答1:

No RefEdit in a modeless Userform

The problem is that you cannot use a modeless userform containing a RefEdit control. Otherwise Excel loses control over the keyboard focus and can only be terminated via task manager or Ctrl + Alt + Delete. So you'll have to show your Userform modal (e.g. expressly by .Show vbModal or without this default argument).

Further hints:

Don't use a RefEdit control within another control, especially not within a Frame control, this can cause issues.

Check if you get a valid range (see Helper function getRng below), then you can assign the new values simply by coding ThisWorkbook.Sheets("Transfer").Range("A1") = Range(Me.RefEdit1.Value) instead of using Copy and Paste.

For non contiguos ranges there are number of code examples at SO, but that's not the cause of Excel freezing. In the code example below I assume that you want to write one cell only to worksheet range Target!A1.

Furthermore I added a boolean variable bReady in order to lock or unlock the Combobox1_Change() event and prevent unnecessary activations.

Code example

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

Helper function 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

Pressing the Ctrl key you are able to select non contiguous ranges, e.g. Sheet1!D12:E15,Sheet1!B7:C10 as completely separate areas (separated by a colon in RefEdit). Referring to your comment, I added the following example how to write back contiguous and non contiguous areas via a variant datafield array (called v in the below example code). As far as I understood you alwayas want to start at cell A1 in your target sheet:

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

回答2:

Thanks to T.M. for his huge help.

By changing his code I came to this answer. also, copy and paste method was working for me, but that was not a good practice.

Anyway, all the credit goes for 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

来源：https://stackoverflow.com/questions/49543651/vba-using-refedit-for-copying-range-between-workbooks

标签

excel

excel-vba

range

userform

vba