ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 怎样文件A数据按H列分类自动写入文件B

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-8-16 18:27 | 显示全部楼层 |阅读模式
文件A中工作表里的数据导入到文件B中工作表,两个表格表头一样.根据B表H列的字符,把符合条件的A表数据导入B表格.就相当于用VBA实现VLOOLUP函数的功能.以下是写的代码,执行后数据完全没导入.我是初学者,0基础的,各位大神摆脱帮忙改下.
Sub 工资表分发()

Dim gzbgh As Long, gzbxm As Long, gzbzw As Long, gzbjb As Long, gzbbm1 As Long, gzbbm2 As Long, gzbsjcqts As Long
Dim gzbxzze As Long, gzbjbf As Long, gzbsx As Long, gzbqqkk As Long, gzbkqfk As Long, gzbcl As Long, gzbdbj As Long, gzbtc As Long
Dim gzbtscl As Long, gzbyfhj As Long, gzbsb As Long, gzbyb As Long, gzbkzs As Long, gzbzk As Long, gzbpcfk As Long
Dim gzbscfk As Long, gzbgsfk As Long, gzbfh As Long, gzbdkhj As Long, gzbsqhj As Long, gzbsfgz As Long, gzbqezk As Long, gzbxjff As Long, gzblzsx As Long

Dim ffbgh As Long, ffbxm As Long, ffbzw As Long, ffbjb As Long, ffbbm1 As Long, ffbbm2 As Long, ffbsjcqts As Long
Dim ffbxzze As Long, ffbjbf As Long, ffbsx As Long, ffbqqkk As Long, ffbkqfk As Long, ffbcl As Long, ffbdbj As Long, ffbtc As Long
Dim ffbtscl As Long, ffbyfhj As Long, ffbsb As Long, ffbyb As Long, ffbkzs As Long, ffbzk As Long, ffbpcfk As Long
Dim ffbscfk As Long, ffbgsfk As Long, ffbfh As Long, ffbdkhj As Long, ffbsqhj As Long, ffbsfgz As Long, ffbqezk As Long, ffbxjff As Long, ffblzsx As Long

Dim ffbcfqrow As Range

Dim gzbrzrq As Date, ffbrzrq As Date

Dim gzb As Worksheet, ffb As Worksheet

ThisWorkbook.Save
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


'打开工资表

Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "导入工资表"
If fd.Show = -1 Then
gzfilename = fd.SelectedItems(1)
Else

Exit Sub

End If

Workbooks.Open filename:=gzfilename

Set gzb = Workbooks(CreateObject("scripting.filesystemobject").getfilename(gzfilename)).Sheets("工资表")

Set ffb = ThisWorkbook.Sheets("程枫区")

ffbgh = ffb.Rows(4).Find(what:="工号", lookat:=xlWhole).Column
ffbxm = ffb.Rows(4).Find(what:="姓名", lookat:=xlWhole).Column
ffbzw = ffb.Rows(4).Find(what:="职务", lookat:=xlWhole).Column
ffbjb = ffb.Rows(4).Find(what:="级别", lookat:=xlWhole).Column
ffbbm1 = ffb.Rows(4).Find(what:="部门1", lookat:=xlWhole).Column
ffbbm2 = ffb.Rows(4).Find(what:="部门2", lookat:=xlWhole).Column
ffbrzrq = ffb.Rows(4).Find(what:="入职日期", lookat:=xlWhole).Column
ffbsjcqts = ffb.Rows(4).Find(what:="实际出勤天数", lookat:=xlWhole).Column
ffbxzze = ffb.Rows(4).Find(what:="薪资总额", lookat:=xlWhole).Column
ffbjbf = ffb.Rows(4).Find(what:="加班费", lookat:=xlWhole).Column
ffbsx = ffb.Rows(4).Find(what:="三薪", lookat:=xlWhole).Column
ffbqqkk = ffb.Rows(4).Find(what:="缺勤扣款", lookat:=xlWhole).Column
ffbkqfk = ffb.Rows(4).Find(what:="考勤罚款", lookat:=xlWhole).Column
ffbcl = ffb.Rows(4).Find(what:="陈列", lookat:=xlWhole).Column
ffbdbj = ffb.Rows(4).Find(what:="达标奖", lookat:=xlWhole).Column
ffbtc = ffb.Rows(4).Find(what:="提成", lookat:=xlWhole).Column
ffbtscl = ffb.Rows(4).Find(what:="特殊处理", lookat:=xlWhole).Column
ffbyfhj = ffb.Rows(4).Find(what:="应发合计", lookat:=xlWhole).Column
ffbsb = ffb.Rows(4).Find(what:="社保", lookat:=xlWhole).Column
ffbyb = ffb.Rows(4).Find(what:="医保", lookat:=xlWhole).Column
ffbkzs = ffb.Rows(4).Find(what:="扣住宿", lookat:=xlWhole).Column
ffbzk = ffb.Rows(4).Find(what:="暂扣", lookat:=xlWhole).Column
ffbpcfk = ffb.Rows(4).Find(what:="盘差罚款", lookat:=xlWhole).Column
ffbscfk = ffb.Rows(4).Find(what:="商场罚款", lookat:=xlWhole).Column
ffbgsfk = ffb.Rows(4).Find(what:="公司罚款", lookat:=xlWhole).Column
ffbfh = ffb.Rows(4).Find(what:="返还", lookat:=xlWhole).Column
ffbdkhj = ffb.Rows(4).Find(what:="代扣合计", lookat:=xlWhole).Column
ffbsqhj = ffb.Rows(4).Find(what:="税前合计", lookat:=xlWhole).Column
ffbsfgz = ffb.Rows(4).Find(what:="实发工资", lookat:=xlWhole).Column
ffbqezk = ffb.Rows(4).Find(what:="全额暂扣", lookat:=xlWhole).Column
ffbxjff = ffb.Rows(4).Find(what:="现金发放", lookat:=xlWhole).Column
ffblzsx = ffb.Rows(4).Find(what:="离职手续", lookat:=xlWhole).Column


gzbgh = gzb.Rows(4).Find(what:="工号", lookat:=xlWhole).Column
gzbxm = gzb.Rows(4).Find(what:="姓名", lookat:=xlWhole).Column
gzbzw = gzb.Rows(4).Find(what:="职务", lookat:=xlWhole).Column
gzbjb = gzb.Rows(4).Find(what:="级别", lookat:=xlWhole).Column
gzbbm1 = gzb.Rows(4).Find(what:="部门1", lookat:=xlWhole).Column
gzbbm2 = gzb.Rows(4).Find(what:="部门2", lookat:=xlWhole).Column
gzbrzrq = gzb.Rows(4).Find(what:="入职日期", lookat:=xlWhole).Column
gzbsjcqts = gzb.Rows(4).Find(what:="实际出勤天数", lookat:=xlWhole).Column
gzbxzze = gzb.Rows(4).Find(what:="薪资总额", lookat:=xlWhole).Column
gzbjbf = gzb.Rows(4).Find(what:="加班费", lookat:=xlWhole).Column
gzbsx = gzb.Rows(4).Find(what:="三薪", lookat:=xlWhole).Column
gzbqqkk = gzb.Rows(4).Find(what:="缺勤扣款", lookat:=xlWhole).Column
gzbkqfk = gzb.Rows(4).Find(what:="考勤罚款", lookat:=xlWhole).Column
gzbcl = gzb.Rows(4).Find(what:="陈列", lookat:=xlWhole).Column
gzbdbj = gzb.Rows(4).Find(what:="达标奖", lookat:=xlWhole).Column
gzbtc = gzb.Rows(4).Find(what:="提成", lookat:=xlWhole).Column
gzbtscl = gzb.Rows(4).Find(what:="特殊处理", lookat:=xlWhole).Column
gzbyfhj = gzb.Rows(4).Find(what:="应发合计", lookat:=xlWhole).Column
gzbsb = gzb.Rows(4).Find(what:="社保", lookat:=xlWhole).Column
gzbyb = gzb.Rows(4).Find(what:="医保", lookat:=xlWhole).Column
gzbkzs = gzb.Rows(4).Find(what:="扣住宿", lookat:=xlWhole).Column
gzbzk = gzb.Rows(4).Find(what:="暂扣", lookat:=xlWhole).Column
gzbpcfk = gzb.Rows(4).Find(what:="盘差罚款", lookat:=xlWhole).Column
gzbscfk = gzb.Rows(4).Find(what:="商场罚款", lookat:=xlWhole).Column
gzbgsfk = gzb.Rows(4).Find(what:="公司罚款", lookat:=xlWhole).Column
gzbfh = gzb.Rows(4).Find(what:="返还", lookat:=xlWhole).Column
gzbdkhj = gzb.Rows(4).Find(what:="代扣合计", lookat:=xlWhole).Column
gzbsqhj = gzb.Rows(4).Find(what:="税前合计", lookat:=xlWhole).Column
gzbsfgz = gzb.Rows(4).Find(what:="实发工资", lookat:=xlWhole).Column
gzbqezk = gzb.Rows(4).Find(what:="全额暂扣", lookat:=xlWhole).Column
gzbxjff = gzb.Rows(4).Find(what:="现金发放", lookat:=xlWhole).Column
gzblzsx = gzb.Rows(4).Find(what:="离职手续", lookat:=xlWhole).Column

Set gzbgzbrow = gzb.Range("H:H").Find(what:=ffb.Cells(i + 5, ffbbm1), lookat:=xlWhole)

If Not gzbgzbrow Is Nothing Then

gzbrow = gzbcfqrow.Row

ffb.Cells(i + 5, ffbgh) = gzb.Cells(gzbrow, gzbgh)
ffb.Cells(i + 5, ffbxm) = gzb.Cells(gzbrow, gzbxm)
ffb.Cells(i + 5, ffbzw) = gzb.Cells(gzbrow, gzbzw)
ffb.Cells(i + 5, ffbjb) = gzb.Cells(gzbrow, gzbjb)
ffb.Cells(i + 5, ffbbm1) = gzb.Cells(gzbrow, gzbbm1)
ffb.Cells(i + 5, ffbbm2) = gzb.Cells(gzbrow, gzbbm2)
ffb.Cells(i + 5, ffbrzrq) = gzb.Cells(gzbrow, gzbrzrq)
ffb.Cells(i + 5, ffbsjcqts) = gzb.Cells(gzbrow, gzbsjcqts)
ffb.Cells(i + 5, ffbxzze) = gzb.Cells(gzbrow, gzbxzze)
ffb.Cells(i + 5, ffbjbf) = gzb.Cells(gzbrow, gzbjbf)
ffb.Cells(i + 5, ffbsx) = gzb.Cells(gzbrow, gzbsx)
ffb.Cells(i + 5, ffbqqkk) = gzb.Cells(gzbrow, gzbqqkk)
ffb.Cells(i + 5, ffbkqfk) = gzb.Cells(gzbrow, gzbkqfk)
ffb.Cells(i + 5, ffbcl) = gzb.Cells(gzbrow, gzbcl)
ffb.Cells(i + 5, ffbdbj) = gzb.Cells(gzbrow, gzbdbj)
ffb.Cells(i + 5, ffbtc) = gzb.Cells(gzbrow, gzbtc)
ffb.Cells(i + 5, ffbtscl) = gzb.Cells(gzbrow, gzbtscl)
ffb.Cells(i + 5, ffbyfhj) = gzb.Cells(gzbrow, gzbyfhj)
ffb.Cells(i + 5, ffbsb) = gzb.Cells(gzbrow, gzbsb)
ffb.Cells(i + 5, ffbyb) = gzb.Cells(gzbrow, gzbyb)
ffb.Cells(i + 5, ffbkzs) = gzb.Cells(gzbrow, gzbkzs)
ffb.Cells(i + 5, ffbzk) = gzb.Cells(gzbrow, gzbzk)
ffb.Cells(i + 5, ffbpcfk) = gzb.Cells(gzbrow, gzbpcfk)
ffb.Cells(i + 5, ffbscfk) = gzb.Cells(gzbrow, gzbscfk)
ffb.Cells(i + 5, ffbgsfk) = gzb.Cells(gzbrow, gzbgsfk)
ffb.Cells(i + 5, ffbfh) = gzb.Cells(gzbrow, gzbfh)
ffb.Cells(i + 5, ffbdkhj) = gzb.Cells(gzbrow, gzbdkhj)
ffb.Cells(i + 5, ffbsqhj) = gzb.Cells(gzbrow, gzbsqhj)
ffb.Cells(i + 5, ffbsfgz) = gzb.Cells(gzbrow, gzbsfgz)
ffb.Cells(i + 5, ffbqezk) = gzb.Cells(gzbrow, gzbqezk)
ffb.Cells(i + 5, ffbxjff) = gzb.Cells(gzbrow, gzbxjff)
ffb.Cells(i + 5, ffblzsx) = gzb.Cells(gzbrow, gzblzsx)


Else

End If


MsgBox ("分发完成,么么哒")

End Sub


TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-16 18:39 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-8-16 18:45 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-8-16 18:56 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
么么哒,写得也太复杂了
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2018-8-16 19:44 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-16 21:33 | 显示全部楼层
求助大神,附件分发功能的代码执行不全.

求助为何分发执行不了.rar

56.02 KB, 下载次数: 2

头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2018-8-16 23:04 来自手机 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽

TA的精华主题

TA的得分主题

发表于 2018-8-17 05:33 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
mcgswy 发表于 2018-8-16 21:33
求助大神,附件分发功能的代码执行不全.

好一个变量王......

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-17 10:31 | 显示全部楼层
刚刚开始接触VBA,文科生O基础,请大家多帮忙.

TA的精华主题

TA的得分主题

发表于 2018-8-17 22:28 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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