ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 491|回复: 2

求助大家帮忙

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-7-11 19:47 | 显示全部楼层 |阅读模式
微信图片_20180711194154.png                                图一
微信图片_20180711194158.png


大家好 我单位即将开始招新生,以前信息都是一个一个输入,有的时候还出错。寻思做个表(图一),招生老师直接输,输入完成点击保存按钮能把输入的信息保存在data表(图二)中,如果点重新输入按钮,图一内容清除,开始下一位新生信息的录入。无耐vba不会,求助大家帮忙写下代码,不胜感激。
报名.rar (13.88 KB, 下载次数: 1)

TA的精华主题

TA的得分主题

发表于 2018-10-4 16:44 | 显示全部楼层
看一下这样可以吗?

副本报名.rar

25.37 KB, 下载次数: 0

TA的精华主题

TA的得分主题

发表于 2018-10-4 16:51 | 显示全部楼层
代码如下
  1. Option Explicit



  2. Sub 保存()
  3. Dim rng As Range, Str As String, UnRng As Range
  4. Set rng = Worksheets(3).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

  5. Rem 检测必录信息是否录入
  6. With Worksheets(1)
  7.    If .Range("c7") = "" Then MsgBox "请输入姓名": Exit Sub
  8.    If .Range("e7") = "" Then MsgBox "请输入性别": Exit Sub
  9.    If .Range("g7") = "" Then MsgBox "请输入出生年月": Exit Sub
  10.    If .Range("g7") = "" Then MsgBox "请输入身份证": Exit Sub
  11.    If .Range("c8") = "" Then MsgBox "请输入父亲姓名": Exit Sub
  12.    If .Range("e8") = "" Then MsgBox "请输入父亲电话": Exit Sub
  13.    If .Range("c9") = "" Then MsgBox "请输入母亲姓名": Exit Sub
  14.    If .Range("e8") = "" Then MsgBox "请输入母亲电话": Exit Sub
  15.    If .Range("i8") = "" Then MsgBox "请输入毕业院校": Exit Sub
  16.    If .Range("i9") = "" Then MsgBox "请输入毕业班级": Exit Sub
  17.    If .Range("c11") = "" Then MsgBox "请输入户籍所在地": Exit Sub
  18.    If .Range("i9") = "" Then MsgBox "请输入家庭住址": Exit Sub
  19. End With

  20. Rem 将信息表数据引入date表
  21. With rng
  22.   .Offset(0, -2) = Worksheets(1).Range("i8")       '毕业院校
  23.   .Offset(0, -1) = Worksheets(1).Range("i9")       '毕业班级
  24.   .Offset(0, 0) = Worksheets(1).Range("c7")        '学生姓名
  25.   .Offset(0, 1) = Worksheets(1).Range("e7")       '性别
  26.   .Offset(0, 2) = Worksheets(1).Range("g7")       '出生日期
  27.   .Offset(0, 3) = Worksheets(1).Range("i7")        '身份证
  28.   .Offset(0, 4) = Worksheets(1).Range("c8")        '父亲姓名
  29.   .Offset(0, 5) = Worksheets(1).Range("e8")       '联系电话
  30.   .Offset(0, 6) = Worksheets(1).Range("c9")       '母亲姓名
  31.   .Offset(0, 7) = Worksheets(1).Range("e9")         '联系电话
  32.   .Offset(0, 8) = Worksheets(1).Range("i11")      '类型
  33.   .Offset(0, 9) = Worksheets(1).Range("c11")      '户籍所在
  34.   .Offset(0, 10) = Worksheets(1).Range("c12")     '家庭住址
  35.   .Offset(0, 11) = Worksheets(1).Range("c14")     '父亲身份
  36.   .Offset(0, 12) = Worksheets(1).Range("e14")     '母亲身份
  37.   .Offset(0, 13) = Worksheets(1).Range("g14")     '房本
  38.   .Offset(0, 14) = Worksheets(1).Range("i14")      '务工
  39.   .Offset(0, 15) = Worksheets(1).Range("d16")     '报到日期
  40. End With
  41. End Sub


  42. Sub 清除()                                 '清除信息表残留数据
  43. Dim UnRng As Range
  44. With Worksheets(1)
  45. Set UnRng = Union(.Range("c7"), .Range("e7"), .Range("g7"), .Range("i7"), _
  46. .Range("c8"), .Range("e8:g8"), .Range("i8"), .Range("c9"), .Range("e9:G9"), _
  47. .Range("i9"), .Range("c11:G11"), .Range("c12:g12"), .Range("i11:i12"), .Range("c14"), _
  48. .Range("e14"), .Range("g14"), .Range("i14"))                     '将需要清除数据的单元格连接起来
  49. UnRng.ClearContents                        '仅清除UnRng中的值,保留格式
  50. End With
  51. End Sub
复制代码


您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 14:00 , Processed in 0.034105 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表