计划部门将生产任务分别保存在了机床和售后两个EXCEL表格中,日常用来办公使用。
1#是机床任务,2#是售后任务
里面的数据是这样的
现在有一个需求,就是想看一下某个项目的任务的完成情况,包括有多少项任务、齐套率和配送率是多少,还有多少任务是没有完成的。
刚开始,是把功能做到这两个清单里面的,后来反映说想在同一个地方查询,不要打开多个文件。
思路:先要将这两个文件的数据复制到同一个地方,于是先建了“数据”表,并新建一个模块
代码如下:
'''用于取另外工作表的数据
Sub GetDataFromAnotherWorkbook()
Dim sourceWorkbook As Workbook
Dim sourceWorksheet As Worksheet
Dim targetWorkbook As Workbook
Dim targetWorksheet As Worksheet
Dim sourceRange As Range
Dim targetRange As Range
Dim MAXRGN As Long
Dim MAXRGN2 As Long
Dim sheetName As String
Dim ws As Worksheet
Dim i As Integer
'''''''''检查工作表是否存在,不存在则新建一个
' 设置要检查的工作表名称
sheetName = "数据"
' 遍历工作簿中的所有工作表,检查是否存在同名工作表
For Each ws In ThisWorkbook.Sheets
If ws.Name = sheetName Then
i = 1
End If
Next ws
'如果没有则新增
If i = 0 Then
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = sheetName
End If
'清除原有数据
ActiveWorkbook.Sheets("数据").Select
MAXRGN = Worksheets("数据").Range("a" & Rows.Count).End(xlUp).Row
If MAXRGN <> 0 Then
Set rng = ActiveSheet.Range("A1:AZ" & MAXRGN)
rng.Clear ' 清除数据
rng.Borders.LineStyle = xlNone ' 移除边框
End If
''''''''取售服任务信息
'设置源工作簿、工作表、范围
f = Dir(ThisWorkbook.Path & "\2#2023售后到货及配送清单.xlsx")
If f = "" Then
MsgBox "2#源文件不存,请查看"
Exit Sub
Else
Set sourceWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & f) '如果设有密码加, Password:="???"
End If
' Set sourceWorkbook = Workbooks.Open(ThisWorkbook.Path & "\2#2023售后到货及配送清单.xlsx")
' Set sourceWorksheet = sourceWorkbook.Worksheets("23年售后")
For Each sourceWorksheet In sourceWorkbook.Worksheets '换成下一年后原来工作名称可能用不了,改成模糊查询
If sourceWorksheet.Name Like "*年售后" Then
Set sourceWorksheet = sourceWorksheet
Exit For
End If
Next sourceWorksheet
' 如果源工作表有过滤,则显示所有数据
If sourceWorksheet.FilterMode = True Then
sourceWorksheet.ShowAllData
End If
'数据源区域
Set sourceRange = sourceWorksheet.Range("A3:AJ3000")
'设置目标工作簿、工作表、范围
Set targetWorkbook = ThisWorkbook
Set targetWorksheet = targetWorkbook.Worksheets("数据")
Set targetRange = targetWorksheet.Range("A1")
'复制数据
sourceRange.Copy targetRange
'关闭源工作簿
sourceWorkbook.Close SaveChanges:=False
'隐藏工作表
'Sheets("Sheet1").Visible = False
'取有效单元格最大值
MAXRGN = Worksheets("数据").Range("a" & Rows.Count).End(xlUp).Row
Worksheets("数据").Range("d2:d" & MAXRGN) = "售服"
''''''''取机床任务信息
'设置源工作簿、工作表、范围
f = Dir(ThisWorkbook.Path & "\1#2023到货及配送清单.xlsx")
If f = "" Then
MsgBox "1#源文件不存,请查看"
Exit Sub
Else
Set sourceWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & f)
End If
' Set sourceWorkbook = Workbooks.Open(ThisWorkbook.Path & "\1#2023到货及配送清单.xlsx")
Set sourceWorksheet = sourceWorkbook.Worksheets("机床")
' 如果源工作表有过滤,则显示所有数据
If sourceWorksheet.FilterMode = True Then
sourceWorksheet.ShowAllData
End If
'数据源区域
Set sourceRange = sourceWorksheet.Range("A3:AJ30000")
'设置目标工作簿、工作表、范围
Set targetWorkbook = ThisWorkbook
Set targetWorksheet = targetWorkbook.Worksheets("数据")
Set targetRange = targetWorksheet.Range("A" & MAXRGN + 1)
'复制数据
sourceRange.Copy targetRange
'关闭源工作簿
sourceWorkbook.Close SaveChanges:=False
'隐藏工作表
' Sheets("数据").Visible = False
'取有效单元格最大值
MAXRGN2 = Worksheets("数据").Range("a" & Rows.Count).End(xlUp).Row
Worksheets("数据").Range(Cells(MAXRGN + 1, 4), Cells(MAXRGN2, 4)) = "机床"
ActiveSheet.Range("A1:AJ1").AutoFilter '将第一行设置成筛选
''
Sheets("查询汇总").Select '转到“查询汇总”表
End Sub
然后再建“汇总统计”表,在表中增一个按钮,命名为“录入机床编号”
代码如下:
Private Sub CommandButton1_Click()
Dim rng As Range
Dim RGE1 As Range
Dim RGE2 As Range
Dim JCBH As String
Dim rowsnum As Integer
Dim JCROWS As Long
Dim JCROWS2 As Long
Dim JCROWS3 As Long
Dim JCROWS4 As Long
Dim JCROWS5 As Long
Dim visibleCells As Range
'如果“数据”表为空,则调用刷新数据功能
rowsnum = Worksheets("数据").Range("A1").End(xlDown).Rows
If rowsnum = 0 Then
CommandButton2.Value = True ' 模拟点击
Application.Wait Now + TimeValue("0:00:01") ' 等待一秒钟,以确保点击事件已经被触发
CommandButton2.Value = False ' 重置按钮状态
End If
'清除"查询汇总"原有数据
Sheets("查询汇总").Select
Range("A4:D8").Value = ""
rowsnum = ActiveSheet.Range("A10").End(xlDown).Rows
If rowsnum <> 0 Then
Set rng = ActiveSheet.Range("A10:Z" & rowsnum)
rng.Clear ' 清除数据
rng.Borders.LineStyle = xlNone ' 移除边框
End If
ActiveWindow.FreezePanes = False '解除窗口冻结
'
'重新选择数据
JCBH = InputBox("请录入机床编号,尽量完整录入,不要模糊查询")
If IsNull(JCBH) Or JCBH = "" Then
MsgBox "机床编号不能为空"
Exit Sub '终止执行代码
Else
JCBH = UCase(JCBH)
End If
Sheets("数据").Select '转到"数据"表
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
'查找B列是否包含JCBH,如果有则过滤复制,没有则退出
Set rng = ActiveSheet.Range("B:B").Find(JCBH)
If Not rng Is Nothing Then
'填充相关数据
With Worksheets("数据")
Dim RNG1 As Range
Dim RNG2 As Range
Set RNG1 = .Columns("AC:AC")
Set RNG2 = .Columns("AD:AD")
JCROWS = WorksheetFunction.CountIf(.Columns("B:B"), "*" & JCBH & "*") '包含JCBH的总行
JCROWS2 = WorksheetFunction.CountIfs(.Columns("B:B"), "*" & JCBH & "*", .Columns("Z:Z"), "/") '包含/的行数,有可能是组部件
JCROWS3 = WorksheetFunction.CountIfs(.Columns("B:B"), "*" & JCBH & "*", .Columns("Z:Z"), ">" & DateAdd("d", -999, Date)) '到货日期是有效日期的数量
JCROWS4 = WorksheetFunction.CountIfs(.Columns("B:B"), "*" & JCBH & "*", .Columns("Z:Z"), ">" & DateAdd("d", -999, Date), RNG1, ">" & Now() - 999) '配送日期是有效日期的数量
JCROWS5 = WorksheetFunction.CountIfs(.Columns("B:B"), "*" & JCBH & "*", .Columns("Z:Z"), ">" & DateAdd("d", -999, Date), RNG1, "", RNG2, ">" & Now() - 999) '当配送日期为空时,看实际配送日期
End With
With Sheets("查询汇总")
.Range("B3").Value = JCBH
.Range("A4").Value = "物料总项数:"
.Range("A5").Value = "已到货项数:"
.Range("A6").Value = "齐套率:"
.Range("C5").Value = "已配送:"
.Range("C6").Value = "配送率:"
.Range("A9").Value = "未到货物料:"
.Range("B4") = JCROWS - JCROWS2 '物料总项数
.Range("B5") = JCROWS3 '已到货项数
.Range("D5") = JCROWS4 + JCROWS5 '已配送
.Range("B6") = (JCROWS3 / (JCROWS - JCROWS2)) * 100 & "%" '齐套率
.Range("D6") = ((JCROWS4 + JCROWS5) / (JCROWS - JCROWS2)) * 100 & "%" '配送率
.Range("B4:B8", "D4:D8").Font.Size = 12
End With
'选择过滤的数据
rowsnum = Worksheets("数据").Range("A1").End(xlDown).Rows '总行数
ActiveSheet.Range("$A$1:$AJ$" & rowsnum).AutoFilter Field:=2, Criteria1:="*" & JCBH & "*" '选中数据范围内第2列,过滤值1为JCBH
ActiveSheet.Range("$A$1:$AJ$" & rowsnum).AutoFilter Field:=26, Operator:=xlFilterValues, Criteria2:=Array(0, "12/31/1900")
'“Operator:=xlFilterValues”指的是上一步筛选后要保留的值 ,选中数据范围内第26列
''选择多区域数据
rowsnum = 0
rowsnum = Worksheets("数据").Range("A1").End(xlDown).Rows
If rowsnum > 0 Then
Set RGE1 = ActiveSheet.Range("A1:H" & rowsnum)
Set RGE2 = ActiveSheet.Range("M1:M" & rowsnum)
Set RGE1 = Union(RGE1, RGE2) '合并多区域
RGE1.Select '选择数据区域
Selection.Copy '复制数据
Sheets("查询汇总").Select '转到“查询汇总”表
Range("A10").Select '选择A4单元格
ActiveSheet.Paste '粘贴数据
'冻结第11行
Sheets("查询汇总").Rows("11:11").Select
ActiveWindow.FreezePanes = True
End If
Else
MsgBox "机床编号" & JCBH & "不存在" '提示
Exit Sub '终止执行代码
End If
'Worksheets("数据").AutoFilterMode = False '清除"数据"表的过滤
Worksheets("数据").ShowAllData '显示所有数据
Sheets("查询汇总").Select '转回"查询汇总"表
End Sub
另外再新增一个按钮,命名为”刷新数据“,作用是如果长时间不操作,以防1#和2#表有变动,进行数据的手工刷新。
代码如下:
Private Sub CommandButton2_Click()
'刷新按钮,复制数据
calldate.GetDataFromAnotherWorkbook
End Sub
演示:
物料查询操作演示
打开后,第一次点击”录入机床编号“时,先取数据;退出EXCEL时,会将数据清空。