12月19/20日 财务会计玩转Excel 300集Office 2010微视频教程
12月22/23日 7天Excel脱白 高效办公必会的Office实战技巧
11月28日 Excel图表之美 网易云课堂-Excel数据透视表应用大全
Excel数据处理与分析实战技巧第1季
查看: 705|回复: 40

零基础9期 第十三课作业贴

[复制链接]
发表于 2017-3-13 22:20:59 | 显示全部楼层 |阅读模式
本帖最后由 zmnyu 于 2017-4-26 16:00 编辑

老规矩
老规矩
老规矩


共性问题:第二题:多工作簿汇总,多数同学对Dir函数能正确理解并使用,但在取完整路径时出错,丢掉了目录最后的 ”\“ ,导致传给Dir函数的参数错误,不能成功打开文件。
第三题:多数同学没有处理平均分的小数位数。


回复

使用道具 举报

发表于 2017-3-14 15:30:31 | 显示全部楼层
本帖最后由 cyxnry 于 2017-3-14 16:03 编辑
  1. Sub 餐馆合计()
  2.     Dim k As Long, filename As String, storename As String, money As Double, i As Long, sumv As Double
  3.     Application.ScreenUpdating = False
  4.     k = 2
  5.     filename = Dir(ThisWorkbook.Path & "\new" & "*.xlsx")
  6.     Do Until filename = ""
  7.         Workbooks.Open ThisWorkbook.Path & "\new" & filename
  8.         storename = WorksheetFunction.Substitute(filename, ".xlsx", "")
  9.         money = Cells(32, "h")
  10.         ActiveWorkbook.Close False
  11.         Cells(k, 1) = storename
  12.         Cells(k, 2) = money
  13.         k = k + 1
  14.         filename = Dir
  15.       
  16.     Loop
  17.     For i = 2 To k
  18.         sumv = sumv + Cells(i, 2)
  19.     Next
  20.     Cells(k, 1) = "各店合计"
  21.     Cells(k, 2) = sumv
  22.     Application.ScreenUpdating = True
  23. End Sub
复制代码
  1. Sub 重新统计()
  2.     Dim peoplea As Long, peopleb As Long, peoplec As Long, peopled As Long, peoplee As Long
  3.     Dim suma As Long, sumb As Long, sumc As Long, sumd As Long, sume As Long
  4.     Dim i As Long
  5.    
  6.         For i = 2 To [a1].CurrentRegion.Rows.Count
  7.             If Cells(i, 2) = "A等" Then
  8.                 peoplea = peoplea + Cells(i, 3)
  9.                 suma = suma + Cells(i, 4) * Cells(i, 3)
  10.             ElseIf Cells(i, 2) = "B等" Then
  11.                 peopleb = peopleb + Cells(i, 3)
  12.                 sumb = sumb + Cells(i, 4) * Cells(i, 3)
  13.             ElseIf Cells(i, 2) = "C等" Or (Cells(i, 2) = "D等") Then
  14.                 peoplec = peoplec + Cells(i, 3)
  15.                 sumc = sumc + Cells(i, 4) * Cells(i, 3)
  16.             ElseIf Cells(i, 2) = "E等" Then
  17.                 peopled = peopled + Cells(i, 3)
  18.                 sumd = sumd + Cells(i, 4) * Cells(i, 3)
  19.             ElseIf Cells(i, 2) = "F等" Then
  20.                 peoplee = peoplee + Cells(i, 3)
  21.                 sume = sume + Cells(i, 4) * Cells(i, 3)
  22.             End If
  23.         Next
  24.         Cells(15, "H") = peoplea
  25.         Cells(15, "I") = suma / peoplea
  26.         Cells(16, "H") = peopleb
  27.         Cells(16, "I") = sumb / peopleb
  28.         Cells(17, "H") = peoplec
  29.         Cells(17, "I") = sumc / peoplec
  30.         Cells(18, "H") = peopled
  31.         Cells(18, "I") = sumd / peopled
  32.         Cells(19, "H") = peoplee
  33.         Cells(19, "I") = sume / peoplee
  34.         
  35. End Sub
复制代码


点评

1、餐馆合计:确认调试了吗?粗心了,“\new”后面少了个“\”,导致路径格式错误取不取文件名。另外,求合计可以放在Do循环里。 2、重新统计:正确。  发表于 2017-4-26 10:17
回复 支持 反对

使用道具 举报

发表于 2017-3-14 15:54:53 | 显示全部楼层
  1. Sub test1()
  2. '   1)创建一个新工作簿;
  3. Application.DisplayAlerts = False
  4. Workbooks.Add
  5. '   2)在新建工作簿中插入一张工作表;
  6. ActiveWorkbook.Worksheets.Add
  7. '   3)将新插入的工作表命名为“零基础VBA”;
  8. ActiveSheet.Name = "零基础VBA"
  9. '   4)复制“零基础VBA”工作表,相同工作簿工作表的最后将其重命名为"胡说老师";
  10. Worksheets("零基础VBA").Copy after:=Sheets(4)
  11. ActiveSheet.Name = "胡说老师"
  12. '   5)将新建工作簿保存为“零基础VBA.xlsx”,存放位置为D盘根目录,直接覆盖保存;
  13. ActiveWorkbook.SaveAs "E:" & "零基础VBA.xlsx"
  14. '   6)删除“零基础VBA”工作表,不要出现删除提示对话框;
  15. Worksheets("零基础VBA").Delete
  16. Application.DisplayAlerts = True
  17. '   7)将“零基础VBA.xlsx”工作簿关闭,但不保存所做的修改
  18. ActiveWorkbook.Close savechanges:=False
  19. End Sub

  20. Sub test2()
  21. Dim name As String, path As String, i As Long, sumv As Double
  22.     Application.DisplayAlerts = False
  23.     Application.ScreenUpdating = False
  24.     path = "E:\EH培训\VBA-基础\正式课13笔记代码及作业\new"
  25.     name = Dir(path & "*.xl*")
  26.     i = 1
  27.     Do
  28.         Workbooks.Open path & name
  29.         Rows.Find("TOTAL $").Offset(0, 1).Copy
  30.         Windows("作业2餐馆合计.xlsm").Activate
  31.         i = i + 1
  32.         Cells(i, 1) = name
  33.         Cells(i, 2).PasteSpecial Paste:=xlPasteValues
  34.         Workbooks(name).Close savechanges:=False
  35.         sumv = sumv + Cells(i, 2)
  36.         name = Dir
  37.     Loop Until name = ""
  38.     Application.DisplayAlerts = True
  39.     Application.ScreenUpdating = True
  40.     Windows("作业2餐馆合计.xlsm").Activate
  41.     i = Range("A1").CurrentRegion.Rows.Count + 1
  42.     Cells(i, 1) = "各店合计"
  43.     Cells(i, 2) = sumv
  44. End Sub

  45. Sub test3()
  46. Dim lvl As Range, rng As Range, i As Long, j As Long, sum_p As Long, sum_s As Double, lv As String
  47. ThisWorkbook.Worksheets.Add
  48. ActiveSheet.Name = "数据源-新的制度"
  49. Worksheets("数据源").Rows.Copy
  50. Worksheets("数据源-新的制度").Range("A1").Select
  51. ActiveSheet.Paste
  52. Set rng = Range("A1").CurrentRegion
  53. For Each lvl In rng
  54.     If lvl = "D等" Then lvl = "C等"
  55.     If lvl = "E等" Then lvl = "D等"
  56.     If lvl = "F等" Then lvl = "E等"
  57. Next
  58. For j = 1 To 5
  59.     Select Case j
  60.     Case Is = 1
  61.         lv = "A等"
  62.     Case Is = 2
  63.         lv = "B等"
  64.     Case Is = 3
  65.         lv = "C等"
  66.     Case Is = 4
  67.         lv = "D等"
  68.     Case Is = 5
  69.         lv = "E等"
  70.     End Select
  71.     For i = 2 To Range("A1").CurrentRegion.Rows.Count
  72.         Select Case Cells(i, 2)
  73.         Case Is = lv
  74.             sum_p = sum_p + Cells(i, 3)
  75.             sum_s = sum_s + Cells(i, 4) * Cells(i, 3)
  76.         End Select
  77.     Next
  78.     Cells(j + 14, 8) = sum_p
  79.     Cells(j + 14, 9) = sum_s / sum_p
  80.     sum_p = 0
  81.     sum_s = 0
  82. Next
  83. End Sub
复制代码

点评

1、正确。 2、没有处理客户名文件的扩展名。 3、正确。  发表于 2017-4-26 10:37
回复 支持 反对

使用道具 举报

发表于 2017-3-15 12:55:17 | 显示全部楼层
本帖最后由 haidai@13 于 2017-3-19 22:35 编辑
  1. <p>Sub CREATEWORKBOOK()
  2.     Application.DisplayAlerts = False
  3.     Dim sht As Worksheet
  4.     Application.Workbooks.Add
  5.    
  6.     Set sht = Application.ActiveWorkbook.Worksheets.Add
  7.     sht.Name = "zerolevelvba"
  8.     ActiveSheet.Copy after:=ActiveSheet
  9.     ActiveSheet.Name = "teacher hu"
  10.      ActiveWorkbook.SaveAs "d:\0levelvba.xlsx"
  11.     Worksheets("zerolevelvba").Delete
  12.    
  13.     ActiveWorkbook.Close False
  14.      
  15. Application.DisplayAlerts = True
  16. End Sub
复制代码
  1. <blockquote>Sub regrade()
复制代码

点评

正确  发表于 2017-4-26 10:40
回复 支持 反对

使用道具 举报

发表于 2017-3-15 12:57:03 | 显示全部楼层
本帖最后由 haidai@13 于 2017-3-19 22:26 编辑

回复多了,不好意思
回复 支持 反对

使用道具 举报

发表于 2017-3-15 16:23:04 | 显示全部楼层
本帖最后由 王晶66 于 2017-3-16 19:47 编辑
  1. 第一题老师讲解完后提交:
  2. Sub 工作簿与工作表对象练习()
  3.       Application.ScreenUpdating = False
  4.       Application.DisplayAlerts = False
  5.       Workbooks.Add
  6.       Worksheets.Add after:=Worksheets(Worksheets.Count)
  7.       Worksheets(Worksheets.Count).Name = "零基础VBA"
  8.       Worksheets("零基础VBA").Copy after:=Worksheets(Worksheets.Count)
  9.       Worksheets(Worksheets.Count).Name = "胡说老师"
  10.       ActiveWorkbook.SaveAs "C:\1.VBA勉強\笔记代码与作业\零基础VBA.xlsx" '我没有D盘,只有一个C盘,暂时放在C盘了
  11.       Worksheets("零基础VBA").Delete
  12.       ActiveWorkbook.Close False
  13.       Application.DisplayAlerts = True
  14.       Application.DisplayAlerts = True
  15. End Sub
复制代码
  1. 第二题:
  2. Sub 餐馆合计()
  3.     Range("a2:b2000").ClearContents
  4.     Application.ScreenUpdating = False
  5.     Application.DisplayAlerts = False
  6.     Dim filename As String
  7.     Dim i As Long
  8.     Dim 合计 As Double
  9.     i = 2
  10.     filename = Dir(ThisWorkbook.Path & "" & "正式课13new\*.xlsx")
  11.     Do Until filename = ""
  12.     Workbooks.Open ("C:\1.VBA勉強\笔记代码与作业\正式课13new" & filename)
  13.         ThisWorkbook.ActiveSheet.Cells(i, 1) = filename
  14.         ThisWorkbook.ActiveSheet.Cells(i, 2) = ActiveWorkbook.ActiveSheet.Range("h32")
  15.         ActiveWorkbook.Close False
  16.         合计 = 合计 + ThisWorkbook.ActiveSheet.Cells(i, 2)
  17.         i = i + 1
  18.         filename = Dir
  19.     Loop
  20.         ThisWorkbook.ActiveSheet.Cells(i, 1) = "各店合计"
  21.         ThisWorkbook.ActiveSheet.Cells(i, 2) = 合计
  22.     Application.ScreenUpdating = True
  23.     Application.DisplayAlerts = True
  24. End Sub
复制代码
  1. 第三题:
  2. Sub 合并组别重新统计()
  3.     Dim i As Long
  4.     Dim j As Long
  5.     Dim 总工资a As Long
  6.     Dim 总工资b As Long
  7.     Dim 总工资c As Long
  8.     Dim 总工资d As Long
  9.     Dim 总工资e As Long
  10.     Range("h15:i19").ClearContents
  11.     For i = 2 To Range("b1").End(xlDown).Row
  12.         j = 15
  13.         If Cells(i, 2) = "A等" Then
  14.             Cells(j, 8) = Cells(j, 8) + Cells(i, 3)
  15.             总工资a = 总工资a + Cells(i, 3) * Cells(i, 4)
  16.             Cells(j, 9) = 总工资a / Cells(j, 8)
  17.         ElseIf Cells(i, 2) = "B等" Then
  18.             Cells(j + 1, 8) = Cells(j + 1, 8) + Cells(i, 3)
  19.             总工资b = 总工资b + Cells(i, 3) * Cells(i, 4)
  20.             Cells(j + 1, 9) = 总工资b / Cells(j + 1, 8)
  21.         ElseIf Cells(i, 2) = "C等" Or Cells(i, 2) = "D等" Then
  22.             Cells(j + 2, 8) = Cells(j + 2, 8) + Cells(i, 3)
  23.             总工资c = 总工资c + Cells(i, 3) * Cells(i, 4)
  24.             Cells(j + 2, 9) = 总工资c / Cells(j + 2, 8)
  25.         ElseIf Cells(i, 2) = "E等" Then
  26.             Cells(j + 3, 8) = Cells(j + 3, 8) + Cells(i, 3)
  27.             总工资d = 总工资d + Cells(i, 3) * Cells(i, 4)
  28.             Cells(j + 3, 9) = 总工资d / Cells(j + 3, 8)
  29.         ElseIf Cells(i, 2) = "F等" Then
  30.             Cells(j + 4, 8) = Cells(j + 4, 8) + Cells(i, 3)
  31.             总工资e = 总工资e + Cells(i, 3) * Cells(i, 4)
  32.             Cells(j + 4, 9) = 总工资e / Cells(j + 4, 8)
  33.         End If
  34.     Next
  35. End Sub
复制代码


点评

1、正确。 2、没有处理客户名文件的扩展名。 3、正确。  发表于 2017-4-26 10:56
回复 支持 反对

使用道具 举报

发表于 2017-3-15 19:37:10 | 显示全部楼层
  1. Sub 作业1()
  2.     Dim sh As Worksheet
  3.     Workbooks.Add                     '1)创建一个新工作簿
  4.     Set sh = Worksheets.Add
  5.     sh.Name = "零基础VBA"             '2)在新建工作簿中插入一张工作表;
  6.     sh.Copy AFTER:=ActiveSheet        '3)将新插入的工作表命名为"零基础VBA"
  7.     ActiveSheet.Name = "胡说老师"     '4)复制"零基础VBA"工作表,相同工作簿工作表的最后将其重命名为"胡说老师";
  8.     ActiveWorkbook.SaveAs "d:\零基础VBA.xlsx"    '5)将新建工作簿保存为"零基础VBA.xlsx",存放位置为D盘根目录,直接覆盖保存
  9.     Application.DisplayAlerts = False '6)删除"零基础VBA"工作表,不要出现删除提示对话框
  10.     sh.Delete
  11.     Application.DisplayAlerts = True
  12.     ActiveWorkbook.Close (False)      '7)将"零基础VBA.xlsx"工作簿关闭,但不保存所做的修改
  13. End Sub

  14. Sub 餐馆合计()
  15.     Dim i As Long, book As Workbook, n As Long, filename As String
  16.     filename = Dir(ThisWorkbook.Path & "\new\*.xls*")
  17.     i = 1
  18.     Do Until filename = ""  '当前文件名为空时退出
  19.         i = i + 1
  20.         Set book = Workbooks.Open(ThisWorkbook.Path & "\new" & filename)
  21.         '打开工作薄
  22.         ThisWorkbook.Sheets(1).Range("a" & i) = book.Sheets(1).Range("a5")
  23.         '提取客户名
  24.         ThisWorkbook.Sheets(1).Range("a" & i).Offset(0, 1) = book.Sheets(1).Range("H32")
  25.         '提取合计
  26.         book.Close (False)
  27.         '关闭工作薄
  28.         filename = Dir
  29.         Debug.Print i
  30.     Loop
  31. End Sub

  32. Sub 合并组别()
  33.     Dim i As Long, j As Long, n As Long, num As Long, sumnum As Long, ave As Double, sumave As Double, lev As String
  34.         For j = 15 To 19
  35.             For i = 2 To 37
  36.                 num = Range("b" & i).Offset(0, 1)   '提取人数
  37.                 ave = Range("b" & i).Offset(0, 2)   '提取平均工资
  38.                 lev = Range("b" & i).Value          '提取等级
  39.                 If lev = "D等" Then                 '按新制度调整等级
  40.                     lev = "C等"
  41.                 ElseIf lev = "E等" Then
  42.                     lev = "D等"
  43.                 ElseIf lev = "F等" Then
  44.                     lev = "E等"
  45.                 End If
  46.                 If lev = Range("g" & j) Then        '计算
  47.                     sumnum = sumnum + num
  48.                     sumave = sumave + num * ave
  49.                     n = n + 1
  50.                 End If
  51.             Next
  52.         Range("h" & j) = sumnum                     '赋值到目标单元格
  53.         Range("h" & j).Offset(0, 1) = sumave / sumnum
  54.         sumnum = 0                                  '下次循环前合计归零
  55.         sumave = 0
  56.         Next
  57. End Sub
复制代码

点评

2、餐馆合计:确认调试了吗?粗心了,“\new”后面少了个“\”,导致路径格式错误取不取文件名。且没有计算合计。 3、正确。  发表于 2017-4-26 11:13
回复 支持 反对

使用道具 举报

发表于 2017-3-15 20:02:42 | 显示全部楼层
学员:低调的小兵
作业一:
  1. Sub 作业一()
  2.     Workbooks.Add
  3.     Worksheets.Add
  4.     ActiveSheet.Name = "零基础VBA"
  5.     Worksheets("零基础VBA").Copy AFTER:=Worksheets(Worksheets.Count)
  6.     ActiveSheet.Name = "胡说老师"
  7.     ActiveWorkbook.SaveAs Filename:="D:\零基础VBA.xlsx"
  8.     Application.DisplayAlerts = False
  9.     Worksheets("零基础VBA").Delete
  10.     Application.DisplayAlerts = True
  11.     Workbooks("零基础VBA.xlsx").Close False
  12. End Sub
复制代码
作业二:
  1. Sub 餐馆合计()
  2.     Dim i As Long, fileName As String, 合计 As Double
  3.     i = 1
  4.     fileName = Dir(ThisWorkbook.Path & "\new\*.xlsx")
  5.     Do
  6.         i = i + 1
  7.         Cells(i, 1) = Left(fileName, InStr(fileName, ".") - 1)
  8.         Workbooks.Open fileName:=ThisWorkbook.Path & "\new" & fileName
  9.         ThisWorkbook.Sheets(1).Cells(i, 2) = Range("H32")
  10.         合计 = 合计 + ThisWorkbook.Sheets(1).Cells(i, 2)
  11.         ActiveWorkbook.Close False
  12.         fileName = Dir
  13.     Loop Until fileName = ""
  14.     Range("A" & Range("A1").CurrentRegion.Rows.Count + 1) = "各店合计"
  15.     Range("B" & Range("A1").CurrentRegion.Rows.Count) = 合计
  16. End Sub
复制代码
作业三:
  1. Sub 作业三()
  2.     Dim 总人数 As Long, 总金额 As Long, i As Long, j As Long
  3.     j = 15
  4.     Cells(20, 7) = "F等"
  5.     For j = 15 To 20
  6.         For i = 2 To Range("A1").CurrentRegion.Rows.Count
  7.             If Cells(i, 2) = Cells(j, 7) Then
  8.                 总人数 = 总人数 + Cells(i, 3)
  9.                 总金额 = 总金额 + Cells(i, 3) * Cells(i, 4)
  10.             End If
  11.         Next
  12.         Cells(j, 8) = 总人数
  13.         Cells(j, 9) = Round(总金额 / 总人数, 2)
  14.         If Cells(j, 7) <> "C等" Then
  15.             总人数 = 0
  16.             总金额 = 0
  17.         End If
  18.     Next
  19.     Range("H18:I20").Copy
  20.     Range("H17:I19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  21.               :=False, Transpose:=False
  22.     Range("G20:I20").Clear
  23. End Sub
复制代码


点评

1、没有实现直接覆盖保存。 2、“\new”后面少了个“\”,导致路径格式错误取不取文件名。 3、正确。  发表于 2017-4-26 11:29
回复 支持 反对

使用道具 举报

发表于 2017-3-16 00:28:14 | 显示全部楼层
本帖最后由 南瓜奶酪汤 于 2017-4-10 15:51 编辑


  1. Sub 作业1()
  2.     Dim sht As Worksheet
  3.     Workbooks.Add
  4.     Sheets.Add.Name = "零基础VBA"
  5.     Sheets("零基础VBA").Copy
  6.     Sheets("零基础VBA").Name = "胡说老师"
  7.     Application.DisplayAlerts = False
  8.     ActiveWorkbook.SaveAs filename:="d:\零基础VBA.XLSX"
  9.     ActiveWorkbook.Close True
  10.     For Each sht In Worksheets
  11.         If sht.Name = "零基础VBA" Then sht.Delete
  12.     Next
  13.     Application.DisplayAlerts = True
  14.     ActiveWorkbook.Close False
  15. End Sub
复制代码
  1. Sub 作业2()
  2.     Dim path As String, wb As String, i As Long, sum As Double, 金额 As Double
  3.     path = ThisWorkbook.path & "\正式课13笔记代码及作业\new"
  4.     wb = Dir(path & "*.xl*")
  5.     i = 2
  6.     sum = 0
  7.     Application.ScreenUpdating = False
  8.     Do Until wb = ""
  9.         金额 = 0
  10.         Cells(i, 1) = wb
  11.         Workbooks.Open filename:=path & wb
  12.         金额 = Range("h32")
  13.         ActiveWorkbook.Close False
  14.         Cells(i, 2) = 金额
  15.         sum = sum + Range("b" & i)
  16.         wb = Dir
  17.         i = i + 1
  18.     Loop
  19.     Range("a" & i) = "合计"
  20.     Range("b" & i) = sum
  21.     Application.ScreenUpdating = True
  22. End Sub
复制代码
  1. Sub 作业3()
  2.     Dim i As Long, j As Long, sumc As Long, sumd As Long
  3.     [a1].CurrentRegion.Select
  4.     Selection.Copy [N1]
  5.     For j = 2 To [N1].CurrentRegion.Rows.Count
  6.         If Range("o" & j) = "D等" Then Range("o" & j) = "C等"
  7.     Next
  8.     For j = 2 To [N1].CurrentRegion.Rows.Count
  9.         If Range("o" & j) = "E等" Then Range("o" & j) = "D等"
  10.     Next
  11.     For j = 2 To [N1].CurrentRegion.Rows.Count
  12.         If Range("o" & j) = "F等" Then Range("o" & j) = "E等"
  13.     Next
  14.     For i = 15 To 19
  15.         sumc = 0
  16.         sumd = 0
  17.         For j = 2 To [N1].CurrentRegion.Rows.Count
  18.             If Range("o" & j) = Range("g" & i) Then
  19.                 sumc = sumc + Range("p" & j)
  20.                 sumd = sumd + Range("p" & j) * Range("q" & j)
  21.             End If
  22.         Next
  23.             Range("h" & i) = sumc
  24.             Range("i" & i) = sumd / sumc
  25.     Next
  26. End Sub
复制代码



点评

1、复制工作表位置错了,应该放在本工作簿。 2、“\new”后面少了个“\”,导致路径格式错误取不取文件名。 3、正确。  发表于 2017-4-26 11:38
回复 支持 反对

使用道具 举报

发表于 2017-3-16 11:53:13 | 显示全部楼层
  1. Sub 作业1()
  2.    
  3.     Dim wb As Workbook, sht As Worksheet
  4.     Application.DisplayAlerts = False
  5.     Set wb = Workbooks.Add
  6.     Set sht = wb.Worksheets.Add
  7.     sht.Name = "零基础VBA"
  8.     sht.Copy after:=sht
  9.     ActiveSheet.Name = "胡说老师"
  10.     wb.SaveAs "D:\零基础VBA.xlsx"
  11.     sht.Delete
  12.     Application.DisplayAlerts = True
  13.     ActiveWorkbook.Close False      
  14. End Sub


  15. Sub 作业2()
  16.     Dim fileName As String, i As Integer, fn As String, wb As Workbook, a As Double
  17.     i = 2
  18.     Application.ScreenUpdating = False
  19.     fileName = Dir(ThisWorkbook.Path & "\new\*.xl*")
  20.     Do Until fileName = ""
  21.        Cells(i, 1) = fileName
  22.         fn = ThisWorkbook.Path & "\new" & fileName
  23.        Set wb = GetObject(fn)
  24.        Cells(i, 2) = wb.Worksheets(1).Range("h32")
  25.        wb.Close False
  26.        a = a + Cells(i, 2).Value
  27.        fileName = Dir
  28.        i = i + 1
  29.     Loop
  30.     Cells(i, 1) = "各店合计"
  31.     Cells(i, 2) = a
  32.     Application.ScreenUpdating = True
  33. End Sub


  34. Sub 作业3()
  35.     Dim i As Integer, j As Integer, 人数 As Long, 工资 As Long
  36.     Application.ScreenUpdating = False
  37.     Range("表1[技能等级]").Select
  38.     Selection.Replace What:="D", Replacement:="C", LookAt:=xlPart, _
  39.         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  40.         ReplaceFormat:=False
  41.     Selection.Replace What:="E", Replacement:="D", LookAt:=xlPart, _
  42.         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  43.         ReplaceFormat:=False
  44.     Selection.Replace What:="F", Replacement:="E", LookAt:=xlPart, _
  45.         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  46.         ReplaceFormat:=False
  47.     For i = 3 To Range("f14").CurrentRegion.Rows.Count
  48.         人数 = 0
  49.         工资 = 0
  50.         For j = 2 To Range("a1").CurrentRegion.Rows.Count
  51.             If Cells(j, 2) = Cells(i + 12, 7) Then
  52.                 人数 = 人数 + Cells(j, 3)
  53.                 工资 = 工资 + Cells(j, 3) * Cells(j, 4)
  54.             End If
  55.         Next
  56.         Cells(i + 12, 8) = 人数
  57.         Cells(i + 12, 9) = 工资 / 人数
  58.     Next
  59.     Application.ScreenUpdating = True
  60. End Sub
复制代码

点评

2、“\new”后面少了个“\”,导致路径格式错误取不取文件名。 3、正确,但改变数据源这种行为不太好。  发表于 2017-4-26 11:50
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 入学

本版积分规则

关闭

站长推荐上一条 /2 下一条

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