Vba 将refedit合并到Vlookup用户表单中

我有一个vlookup用户表单，它根据座位n°自动填写表单中的详细信息

现在我想将ref-edit按比例分配，以将这些数据从文本框粘贴到用户使用refedit选择的单元格中。因此，我需要一些帮助来进行这些工作
这是我使用过的代码。

我可能希望插入3个参考编辑框，供用户从文本框中选择他们想要粘贴每个数据（名称、部门和外部编号）的单元格

请参见下面的我的代码：

Option Explicit

Private Sub Frame1_Click()

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

   Dim answer As Integer
   answer = TextBox1.Value
   TextBox2.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 2, False)
   TextBox3.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 3, False)
   TextBox4.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 4, False)

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox3_Change()

End Sub

Private Sub TextBox4_Change()

End Sub
Private Sub CancelButton_Click()

    Unload Me
    End
End Sub

我试图找出一个代码来解决这个问题，但我得到了一个对象必需的错误。我的rngcopy将是textbox2.value（Name），rngpast位置将是ref edit 1

这是密码

Private Sub PasteButton_Click()

Dim rngCopy As Range, rngPaste As Range
Dim wsPaste As Range
Dim answer As Integer
answer = TextBox1.Value
If RefEdit1.Value <> "" Then

        TextBox2.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 2, False)
        Set rngCopy = TextBox2.Value
        Set wsPaste = ThisWorkbook.Sheets(Replace(Split(TextBox2.Value, "!")(0), "'", ""))
        Set rngPaste = wsPaste.Range(Split(TextBox2.Value, "!")(1))

        rngCopy.Copy rngPaste
  Else
        MsgBox "Please select an Output range"
    End If
End Sub

Private子粘贴按钮_Click（）
变暗rngCopy作为范围，RNGPast作为范围
将wsPaste设置为范围
将答案设置为整数
答案=文本框1.值
如果RefEdit1.Value为“”，则
TextBox2.Value=WorksheetFunction.VLookup（答案，表格（“L12-数据表”）。范围（“B:E”），2，假）
设置rngCopy=TextBox2.Value
设置wsPaste=ThisWorkbook.Sheets（替换（拆分（TextBox2.Value，“！”）（0），“，”）
设置rngpast=wsPaste.Range（拆分（TextBox2.Value，“！”）（1））
rngCopy.Copy rngPaste
其他的
MsgBox“请选择一个输出范围”
如果结束
端接头

您应该使用Match获取行索引，并将其公开到表单中，以便复制函数可以使用它。 要设置Ref控件指向的目标，只需使用Range（）计算.Value属性：

表格：

守则：

' constants to define the data
Const SHEET_DATA = "L12 - Data Sheet"
Const COLUMN_SEAT = "B"
Const COLUMNN_NAME = "C"
Const COLUMN_DEPT = "D"
Const COLUMN_EXTNO = "E"

Private Sheet As Worksheet
Private RowIndex As Long

Private Sub TxtSeatNo_Change()
  Dim seatno

  'clear the fields first
  Me.TxtName.value = Empty
  Me.TxtDept.value = Empty
  Me.TxtExtNo.value = Empty
  RowIndex = 0

  If Len(TxtSeatNo.value) Then
    Set Sheet = ThisWorkbook.Sheets(SHEET_DATA)

    On Error Resume Next

    ' get the seat number to either string or double
    seatno = TxtSeatNo.value
    seatno = CDbl(seatno)

    ' get the row index containing the SeatNo
    RowIndex = WorksheetFunction.match(seatno, _
                                       Sheet.Columns(COLUMN_SEAT), _
                                       0)
    On Error GoTo 0
  End If

  If RowIndex Then
    ' copy the values from the sheet to the text boxes
    Me.TxtName.value = Sheet.Cells(RowIndex, COLUMNN_NAME)
    Me.TxtDept.value = Sheet.Cells(RowIndex, COLUMN_DEPT)
    Me.TxtExtNo.value = Sheet.Cells(RowIndex, COLUMN_EXTNO)
  End If
End Sub

Private Sub BtCopy_Click()
  If RowIndex < 1 Then Exit Sub

  ' copy the current values to the cells pointed by the ref controls

  If Len(Me.RefName.value) Then _
    Range(Me.RefName.value) = Sheet.Cells(RowIndex, COLUMNN_NAME)

  If Len(Me.RefDept.value) Then _
    Range(Me.RefDept.value) = Sheet.Cells(RowIndex, COLUMN_DEPT)

  If Len(Me.RefExtNo.value) Then _
    Range(Me.RefExtNo.value) = Sheet.Cells(RowIndex, COLUMN_EXTNO)
End Sub

Private Sub BtlClose_Click()
  ' close the form
  Unload Me
End Sub

定义数据的常量 施工图\u DATA=“L12-数据表” Const COLUMN_SEAT=“B” Const COLUMNN_NAME=“C” Const COLUMN\u DEPT=“D” Const COLUMN_EXTNO=“E” 专用工作表作为工作表 私有行索引长度为 私人分公司TxtSeatNo_变更（） 昏暗的海滩 "先清理田地, Me.TxtName.value=空 Me.TxtDept.value=空 Me.TxtExtNo.value=空 行索引=0 如果Len（TxtSeatNo.value）则 设置工作表=此工作簿。工作表（工作表数据） 出错时继续下一步 '将座位号设置为字符串或双精度 seatno=TxtSeatNo.value seatno=CDbl（seatno） '获取包含SeatNo的行索引 RowIndex=工作表函数.match（seatno_ 表.立柱（立柱座）_ 0) 错误转到0 如果结束 如果是行索引，那么 '将值从工作表复制到文本框 Me.TxtName.value=Sheet.Cells（行索引、列名称） Me.TxtDept.value=Sheet.Cells（行索引，列\部门） Me.TxtExtNo.value=Sheet.Cells（行索引，列_EXTNO） 如果结束 端接头 专用子BtCopy_Click（） 如果RowIndex<1，则退出Sub '将当前值复制到ref控件指向的单元格 如果Len（Me.RefName.value），则_ 范围（Me.RefName.value）=表单元格（行索引、列名称） 如果Len（Me.RefDept.value），则_ 范围（Me.RefDept.value）=图纸单元格（行索引、列\部门） 如果Len（Me.RefExtNo.value），则_ 范围（Me.RefExtNo.value）=表单元格（行索引，列_EXTNO） 端接头 专用子BtlClose_Click（） “关闭窗体 卸下我 端接头

---

您应该使用Match获取行索引，并将其公开到表单中，以便复制函数可以使用它。 要设置Ref控件指向的目标，只需使用Range（）计算.Value属性：

表格：

守则：

' constants to define the data
Const SHEET_DATA = "L12 - Data Sheet"
Const COLUMN_SEAT = "B"
Const COLUMNN_NAME = "C"
Const COLUMN_DEPT = "D"
Const COLUMN_EXTNO = "E"

Private Sheet As Worksheet
Private RowIndex As Long

Private Sub TxtSeatNo_Change()
  Dim seatno

  'clear the fields first
  Me.TxtName.value = Empty
  Me.TxtDept.value = Empty
  Me.TxtExtNo.value = Empty
  RowIndex = 0

  If Len(TxtSeatNo.value) Then
    Set Sheet = ThisWorkbook.Sheets(SHEET_DATA)

    On Error Resume Next

    ' get the seat number to either string or double
    seatno = TxtSeatNo.value
    seatno = CDbl(seatno)

    ' get the row index containing the SeatNo
    RowIndex = WorksheetFunction.match(seatno, _
                                       Sheet.Columns(COLUMN_SEAT), _
                                       0)
    On Error GoTo 0
  End If

  If RowIndex Then
    ' copy the values from the sheet to the text boxes
    Me.TxtName.value = Sheet.Cells(RowIndex, COLUMNN_NAME)
    Me.TxtDept.value = Sheet.Cells(RowIndex, COLUMN_DEPT)
    Me.TxtExtNo.value = Sheet.Cells(RowIndex, COLUMN_EXTNO)
  End If
End Sub

Private Sub BtCopy_Click()
  If RowIndex < 1 Then Exit Sub

  ' copy the current values to the cells pointed by the ref controls

  If Len(Me.RefName.value) Then _
    Range(Me.RefName.value) = Sheet.Cells(RowIndex, COLUMNN_NAME)

  If Len(Me.RefDept.value) Then _
    Range(Me.RefDept.value) = Sheet.Cells(RowIndex, COLUMN_DEPT)

  If Len(Me.RefExtNo.value) Then _
    Range(Me.RefExtNo.value) = Sheet.Cells(RowIndex, COLUMN_EXTNO)
End Sub

Private Sub BtlClose_Click()
  ' close the form
  Unload Me
End Sub

定义数据的常量 施工图\u DATA=“L12-数据表” Const COLUMN_SEAT=“B” Const COLUMNN_NAME=“C” Const COLUMN\u DEPT=“D” Const COLUMN_EXTNO=“E” 专用工作表作为工作表 私有行索引长度为 私人分公司TxtSeatNo_变更（） 昏暗的海滩 "先清理田地, Me.TxtName.value=空 Me.TxtDept.value=空 Me.TxtExtNo.value=空 行索引=0 如果Len（TxtSeatNo.value）则 设置工作表=此工作簿。工作表（工作表数据） 出错时继续下一步 '将座位号设置为字符串或双精度 seatno=TxtSeatNo.value seatno=CDbl（seatno） '获取包含SeatNo的行索引 RowIndex=工作表函数.match（seatno_ 表.立柱（立柱座）_ 0) 错误转到0 如果结束 如果是行索引，那么 '将值从工作表复制到文本框 Me.TxtName.value=Sheet.Cells（行索引、列名称） Me.TxtDept.value=Sheet.Cells（行索引，列\部门） Me.TxtExtNo.value=Sheet.Cells（行索引，列_EXTNO） 如果结束 端接头 专用子BtCopy_Click（） 如果RowIndex<1，则退出Sub '将当前值复制到ref控件指向的单元格 如果Len（Me.RefName.value），则_ 范围（Me.RefName.value）=表单元格（行索引、列名称） 如果Len（Me.RefDept.value），则_ 范围（Me.RefDept.value）=图纸单元格（行索引、列\部门） 如果Len（Me.RefExtNo.value），则_ 范围（Me.RefExtNo.value）=表单元格（行索引，列_EXTNO） 端接头 专用子BtlClose_Click（） “关闭窗体 卸下我 端接头

---

将您的

rngCopy

声明为范围对象，然后将其绑定到范围对象的

.value

方法

Set rngCopy=TextBox2.Value

这可能是您遇到错误的地方。尝试声明一个

字符串

，并将其分配给您的副本值

Dim string1 As String
string1 = TextBox2.Value

---

打开局部变量窗口，逐步通过代码编辑器，当您为

rngCopy

对象分配一个字符串时，请观察它会发生什么情况。

您将

rngCopy

声明为范围对象，然后将其绑定到范围对象的

值
方法

Set