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

mcgswy

文件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

mcgswy

表格截图见下图

不知道为什么

mcgswy 发表于 2018-8-16 18:39
表格截图见下图

看着都心慌，是不是密集恐惧症得原因啊。

xyxcc177

么么哒，写得也太复杂了

mcgswy

求助大神,附件分发功能的代码执行不全.

lsc900707

mcgswy 发表于 2018-8-16 21:33
求助大神,附件分发功能的代码执行不全.

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

mcgswy

刚刚开始接触VBA,文科生O基础,请大家多帮忙.

vfp_new

楼主精神可嘉，加油！