用UserForm中的TextBox捕获单元格值

我有一个UserForm应该能够复制粘贴单元格的理想select。 所以首先我要点击我想要复制的范围，然后激活UserForm。 UserForm将有一个combobox来select我要粘贴数据的工作表，然后它将转到该工作表，用户将点击他想要粘贴数据的范围或单元格。

我原来做了一个input框代码来做到这一点，它的工作原理是完美的，但是当我在UserForm中执行它不起作用，因为我不能将Type:=8代码合并到文本框中。 因此，我将需要一些帮助，我怎样才能启用我的UserForm粘贴工作表上的单元格数据，类似于我在application.inputbox所做的。

这是一个input框forms的完美工作代码：

 Sub CopyPasteCumUpdateWithinSameSheet() Dim rng As Range Dim inp As Range Selection.Interior.ColorIndex = 37 Set inp = Selection On Error Resume Next Set rng = Application.InputBox("Copy to", Type:=8) On Error GoTo 0 If TypeName(rng) <> "Range" Then Exit Sub Else inp.Copy rng.Select ActiveSheet.Paste Link:=True 'Cells(1,2).Font.ThemeColor = End If End Sub 

这是我尝试过的UserForm：

 Dim Sh As Worksheet Private Sub CommandButton1_Click() On Error GoTo 0 If TypeName(rng) <> "Range" Then Exit Sub Else inp.Copy rng.Select ActiveSheet.Paste Link:=True End If End Sub Private Sub UserForm_Initialize() CopyPasteUserform.Show vbModeless For Each Sh In ThisWorkbook.Sheets If Sh.Name <> "Inputs" Then ComboBox1.AddItem Sh.Name End If Next ComboBox1.Style = fmStyleDropDownList End Sub Private Sub ComboBox1_Change() With ThisWorkbook.Sheets(ComboBox1.Text) .Visible = xlSheetVisible .Activate End With End Sub Private Sub TextBox1_Change() Dim rng As Range Dim inp As Range Selection.Interior.ColorIndex = 37 Set inp = Selection On Error Resume Next Set rng = TextBox.Value End Sub 

我试图合并用户窗体，但所有其他function停止响应除了RefEdit。

 Dim Sh As Worksheet Private Sub UserForm_Initialize() CopyPasteUserform.Show vbModeless For Each Sh In ThisWorkbook.Sheets If Sh.Name <> "Inputs" Then ComboBox1.AddItem Sh.Name End If Next ComboBox1.Style = fmStyleDropDownList Dim rng As Range Dim inp As Range Selection.Interior.ColorIndex = 37 Set inp = Selection End Sub Private Sub Combobox1_Change() With ThisWorkbook.Sheets(ComboBox1.Text) .Visible = xlSheetVisible .Activate End With End Sub Private Sub RefEdit1_Change() Label1.Caption = "" If RefEdit1.Value <> "" Then _ Label1.Caption = "[" & ComboBox1 & "]" & RefEdit1 Dim rng As Range Dim inp As Range On Error Resume Next Set rng = RefEdit1.Value On Error GoTo 0 If TypeName(rng) <> "Range" Then Exit Sub Else inp.Copy rng.Select ActiveSheet.Paste Link:=True End If End Sub 

Answer 1

您不需要combobox导航到工作表。 这是Refedit的美丽

这是你正在尝试？ 我没有做任何error handling。 我相信你可以照顾的。

1. 创build一个用户表单，并放置2个标签，2个refedits和1个命令button，如下所示

   

2. 接下来将这个代码粘贴到用户表单代码区域

码

 Private Sub CommandButton1_Click() Dim rngCopy As Range, rngPaste As Range Dim wsCopy As Worksheet, wsPaste As Worksheet If RefEdit1.Value <> "" And RefEdit2.Value <> "" Then Set wsCopy = ThisWorkbook.Sheets(Replace(Split(RefEdit1.Value, "!")(0), "'", "")) Set rngCopy = wsCopy.Range(Split(RefEdit1.Value, "!")(1)) Set wsPaste = ThisWorkbook.Sheets(Replace(Split(RefEdit2.Value, "!")(0), "'", "")) Set rngPaste = wsPaste.Range(Split(RefEdit2.Value, "!")(1)) rngCopy.Copy rngPaste Else MsgBox "Please select Input and Output range" End If End Sub 

在行动

数据将从Sheet1!$A$1:$A$3复制到Sheet2!$A$1:$A$3

跟进评论

但是，pastelinkfunction已经在用户表单中遗漏了。 是否有可能将它纳入？:) – 尼瓦7分钟前

添加一个checkbox到窗体如下所示

使用这个代码

 Private Sub CommandButton1_Click() Dim rngCopy As Range, rngPaste As Range Dim wsCopy As Worksheet, wsPaste As Worksheet If RefEdit1.Value <> "" And RefEdit2.Value <> "" Then Set wsCopy = ThisWorkbook.Sheets(Replace(Split(RefEdit1.Value, "!")(0), "'", "")) Set rngCopy = wsCopy.Range(Split(RefEdit1.Value, "!")(1)) Set wsPaste = ThisWorkbook.Sheets(Replace(Split(RefEdit2.Value, "!")(0), "'", "")) Set rngPaste = wsPaste.Range(Split(RefEdit2.Value, "!")(1)) If CheckBox1.Value = True Then wsPaste.Activate rngPaste.Select rngCopy.Copy ActiveSheet.Paste Link:=True Else rngCopy.Copy rngPaste End If Else MsgBox "Please select Input and Output range" End If End Sub 

Answer 2

说明：types：= 8将检查用户是否input正确的范围名称？ 在用户窗体的文本框没有这个function。 但是当用户点击button时我们可以检测到这个错误。 看我的代码。

无需检查文本框是否发生变化，我删除了textbox_change的代码。

在你的用户表单代码区replace如下。

 Option Explicit Dim Sh As Worksheet Dim inp As Range Dim rng As Range Private Sub CommandButton1_Click() ActiveCell.Value = Me.TextBox1.Text 'On Error Resume Next 'If TypeName(Range(Me.TextBox1.Text)) <> "Range" Then ' MsgBox "Invalid range name!", vbCritical ' Exit Sub 'Else ' inp.Copy ' rng.Select ' ' ActiveSheet.Paste Link:=True ' MsgBox "Copy and paste finish.", vbInformation 'End If 'On Error GoTo 0 End Sub Private Sub UserForm_Initialize() For Each Sh In ThisWorkbook.Sheets If Sh.Name <> "Inputs" Then ComboBox1.AddItem Sh.Name End If Next ComboBox1.Style = fmStyleDropDownList End Sub Private Sub ComboBox1_Change() With ThisWorkbook.Sheets(ComboBox1.Text) .Visible = xlSheetVisible .Activate End With End Sub