[已解决]帮忙写段代码(工资表导入)

fjmxwrs · 发表于 2011-8-14 01:41

本帖最后由 fjmxwrs 于 2011-8-14 10:29 编辑

回复 opelwang 的帖子

Sub 数据合并()
Dim Qssj, Lj As String, Wj As String, Xm As String, Sj As Double
Dim Rq As Long, Xrl As Long, Xrh As Long, Qsh As Long, i3 As Date
Dim i1 As String, i2 As String, ttt As String, k As Long
On Error Resume Next
Qssj = Timer
Lj = ThisWorkbook.Path & "\00"
i1 = InputBox("请输入开始日期：d")
If i1 = "" Then Exit Sub
i2 = InputBox("请输入结束日期：d")
If Len(i2) = 0 Then Exit Sub
i3 = Range("D2").Value
Application.ScreenUpdating = False
Range("D3:AI59").ClearContents
For x = i1 To i2
tt = Format(i3, "yyyy-mm") & "-" & Format(x, "00")
Wj = Dir(Lj & tt & ".xls")
If Wj = "" Then
If ttt = "" Then
ttt = tt
Else
ttt = ttt & Chr(10) & tt
End If
k = k + 1
GoTo aa
End If
Workbooks.Open (Lj & Wj)
Rq = Mid(tt, 9, 2)
Xrl = Rq + 3
With ActiveWorkbook.Sheets("花名冊")
For i = 40 To 55
Qsh = Range("B2:B50").Find(.Cells(1, i)).Row
For j = 2 To 7
Sj = .Cells(j, i)
Xm = .Cells(j, 39)
Select Case Xm
Case "生產數量"
Xrh = Qsh
Cells(Xrh, Xrl) = Cells(Xrh, Xrl) + Sj
Cells(Xrh, 35) = Cells(Xrh, 35) + Sj
Case "生產時間"
Xrh = Qsh + 1
Cells(Xrh, Xrl) = Cells(Xrh, Xrl) + Sj
Cells(Xrh, 35) = Cells(Xrh, 35) + Sj
Case "生產面積"
Xrh = Qsh + 2
Cells(Xrh, Xrl) = Cells(Xrh, Xrl) + Sj
Cells(Xrh, 35) = Cells(Xrh, 35) + Sj
End Select
Next j
Next i
End With
ActiveWorkbook.Close True
aa:
Next x
Application.ScreenUpdating = True
If ttt = "" Then
MsgBox "共用时" & Round((Timer - Qssj), 0) & "秒!"
Else
MsgBox ttt & Chr(10) & k & "个文件不存在" & Chr(10) & "共用时" & Round((Timer - Qssj), 0) & "秒!"
End If
End Sub

复制代码

1.解决了输入日期问题：只需要输入日
2.解决了没找到文件时出错的问题
3.解决了提示没有找到的文件。

opelwang · 发表于 2011-8-14 01:58

非常感谢fjmxwrs版主帮忙与指点~~~
10楼的代码才是想要的结果，结贴了哟...

opelwang · 发表于 2011-8-14 02:28

本帖最后由 opelwang 于 2011-8-14 02:28 编辑

fjmxwrs 版主，仔细测试了下，出现了异常：
输入开始日期为：1
结束日期为：9
看看提示是什么？

再测试结束为：10 或者以后的日期数字，提示又是？？

好象有点问题了...

烦请再帮忙看看，谢谢了~~~

fjmxwrs · 发表于 2011-8-14 10:30

本帖最后由 fjmxwrs 于 2011-8-14 10:34 编辑

回复 opelwang 的帖子

代码没有你说的问题呀，在我这运行正常。
现简化一下循环，最佳楼层代码已经更新

opelwang · 发表于 2011-8-14 13:09

本帖最后由 opelwang 于 2011-8-14 13:10 编辑

还有一个问题要烦请版主再帮忙修正一下，报表格式改动了一下。
原格式：

改变后的格式：附件：

2011-08-01.rar (135.17 KB, 下载次数: 0)

fjmxwrs · 发表于 2011-8-14 13:36

你自己一点也看不懂代码是吗？那你还弄什么代码呢？先从头报班学习吧！！
再说了，问题不是这样出的，花一个晚上时间给你处理一个问题，终了你说表改了一下，真有你的！！
把循环2 to 7的7改成4即可。其他不变

syt188702 · 发表于 2011-8-14 13:50

不要要求太高，有名师给你点评是好事，我有一问题贴发了一两天无人问

opelwang · 发表于 2011-8-14 14:02

准备报名，从头学习。

jiminyanyan · 发表于 2011-8-14 14:03

楼主的学习方法有问题，一年前我己提醒过楼主的，楼主估计很少自己去研究代码，说到底还是没消化。测试也就是简单运行了一下，有问题就又跑来问了，而没有自己独立去解决问题，去了解这些代码是什么意思。
如真的对VBA没什么兴趣。建议多学基础功能，函数，数据透视表，其实很多东西不一定要用代码来解决的

fjmxwrs · 发表于 2011-8-14 14:17

回复 jiminyanyan 的帖子

一年前？？

		自动登录	找回密码
密码			注册