[已解决]如何把用户窗体录入的数据记录到其他工作表而不是当前工作表。

ww87398804

请问各位老师，这是一个新员工录入窗口，但是录入的数据在当前工作表，如何修改代码使录入的数据录入其他工作表，如sheet2、或者sheet3等其他工作表，谢谢了。

Private Sub CommandButton1_Click()
x = Range("A65536").End(xlUp).Row + 1 '行数
Y = Application.CountIf(Range("A2:A" & x), TextBox1.Text) '计算输入的姓名在工作表中的个数
If Y > 0 Then
MsgBox "没有输入新员工姓名或输入的员工姓名已存在，请重新输入", , "提示"
TextBox1.Text = "" '清空文本框
Else
Cells(x, 1).Resize(1, 7) = Array(TextBox1.Text, TextBox2.Text, ComboBox5.Text, ComboBox2.Text, ComboBox1.Text, ComboBox3.Text, ComboBox4.Text)
End
End If

End Sub

Private Sub TextBox1_Click()

End Sub

Private Sub TextBox2_Click()

End Sub

Private Sub ComboBox5_Change()

End Sub

Private Sub ComboBox2_Change()

End Sub

Private Sub ComboBox1_Change()

End Sub

Private Sub ComboBox3_Click()

End Sub

Private Sub ComboBox4_Click()

End Sub


'发生在单元格内容改变后
Private Sub Worksheet_Change(ByVal Target As Range)

'关闭应用程序对事件的再次响应,因为代码还可以触发自身这个Change事件
    Application.EnableEvents = False

'关闭代码运行时,屏幕的更新
    Application.ScreenUpdating = False

'出现运行错误忽略
    On Error Resume Next

'定义变量Row_dn为数据记录到的最后一行
'定义变量Row1和Col1为记载当前单元格的行列号
'定义变量myRange为单元格对象变量,循环用
    Dim Row_dn, Row1, Col1 As Integer
    Dim String1 As String
    Dim myRange As Range

'以下三句对变量分别赋值
     Row1 = Target.Row
     Col1 = Target.Column
     Row_dn = Range("A65536").End(xlUp).Row

'====此循环判断====
'范围: 在从A2单元格到A列基本数据[不包括汇总行]的最后一行范围里
'条件: myRange所在行的前三个单元格如果都为空值,即满足条件
'动作: 删除myRange所在行,将应用程序事件响应和屏幕更新调回默认值,退出过程
    For Each myRange In Range(Cells(2, 1), Cells(Row_dn - 2, 1))
        If myRange = "" And myRange.Offset(0, 1) = "" And myRange.Offset(0, 2) = "" Then
            myRange.Rows.EntireRow.Delete
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
            Exit Sub
        End If
     Next myRange
'====================

'如果用户鼠标选择单元格范围超过两行,退出过程
     If Selection.EntireRow.Count >= 2 Then
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Exit Sub
     End If

'判断执行语句
'条件: 目标只要不在标题行Row1>2
      '并且在A列Col1=1
      '并且在汇总行上面一行Row_dn-1
      '并且输入了值Cells(Row1, Col1) <> ""
'动作:将原先汇总行移到下一行并清空原行内容,新记录行同时复制上方公式到自身
     If Row1 >= 2 And Col1 = 1 And Row1 = Row_dn - 1 And Cells(Row1, Col1) <> "" Then
       String1 = Cells(Row_dn, 1)
       Cells(Row1, 4).Formula = "=RC[-2]*RC[-1]"
       Cells(Row_dn, 1).ClearContents
       Cells(Row_dn, 3).ClearContents
       Cells(Row_dn, 4).ClearContents

       Cells(Row_dn + 1, 1).Formula = String1
       Cells(Row_dn + 1, 3).Formula = "=SUM(R2C3:R[-1]C3)"
       Cells(Row_dn + 1, 4).Formula = "=SUM(R2C4:R[-1]C4)"
     End If

'过程结束,记得将应用程序事件响应和屏幕更新调回默认值
     With Application
         .EnableEvents = True
         .ScreenUpdating = True
     End With
End Sub


Private Sub TextBox3_Change()

End Sub

Private Sub Label8_Click()

End Sub

Private Sub UserForm_Click()

End Sub

最佳答案

月排行榜 / 总排行榜

这儿有肥猫

2014-9-3 13:24

这一句也要改
x = sheets("Sheet2").Range("A65536").End(xlUp).Row + 1 '行数

这一句看情况，如果是判断在当前工作表中textbox里面的是否重复，就不变，如果是在sheet2里面，就在range前面加sheets("Sheet2")
Y = Application.CountIf(Range("A2:A" & x), TextBox1.Text)

跳转到最佳答案楼层

这儿有肥猫

上附件，看这么长个代码眼都花了
初步判定是这句Cells(x, 1).Resize(1, 7) = Array(TextBox1.Text, TextBox2.Text, ComboBox5.Text, ComboBox2.Text, ComboBox1.Text, ComboBox3.Text, ComboBox4.Text)

改成 sheets("Sheet2").Cells(x, 1).Resize(1, 7) = Array(TextBox1.Text, TextBox2.Text, ComboBox5.Text, ComboBox2.Text, ComboBox1.Text, ComboBox3.Text, ComboBox4.Text)
即可

这儿有肥猫

x = Range("A65536").End(xlUp).Row + 1 '行数
Y = Application.CountIf(Range("A2:A" & x), TextBox1.Text)

wp8680

Private Sub CommandButton1_Click()
    With Sheets("目标工作表名")
        x = .Range("A65536").End(xlUp).Row + 1    '行数
        Y = Application.CountIf(.Range("A2:A" & x), TextBox1.Text)    '计算输入的姓名在工作表中的个数
        If Y > 0 Then
            MsgBox "没有输入新员工姓名或输入的员工姓名已存在，请重新输入", , "提示"
            TextBox1.Text = ""    '清空文本框
        Else
            .Cells(x, 1).Resize(1, 7) = Array(TextBox1.Text, TextBox2.Text, ComboBox5.Text, ComboBox2.Text, ComboBox1.Text, ComboBox3.Text, ComboBox4.Text)
            End
        End If
    End With
End Sub

这儿有肥猫

这一句也要改
x = sheets("Sheet2").Range("A65536").End(xlUp).Row + 1 '行数

这一句看情况，如果是判断在当前工作表中textbox里面的是否重复，就不变，如果是在sheet2里面，就在range前面加sheets("Sheet2")
Y = Application.CountIf(Range("A2:A" & x), TextBox1.Text)

ww87398804

wp8680 发表于 2014-9-3 13:23
Private Sub CommandButton1_Click()
    With Sheets("目标工作表名")
        x = .Range("A65536"). ...

唉，加入了，还是在当前工作表，

ww87398804

已解决，谢谢各位。