EXCEL VBA 进行物料信息的相关汇总统计

锁匙isthekey

已于 2023-10-10 12:41:48 修改

阅读量285

点赞数 1

文章标签： excel

于 2023-09-25 15:22:16 首次发布

本文链接：https://blog.csdn.net/weixin_44819434/article/details/133271223

版权

计划部门将生产任务分别保存在了机床和售后两个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时，会将数据清空。

锁匙isthekey

关注

1
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
EXCEL VBA 进行物料信息的相关汇总统计

现在有一个需求，就是想看一下某个项目的任务的完成情况，包括有多少项任务、齐套率和配送率是多少，还有多少任务是没有完成的。另外再新增一个按钮，命名为”刷新数据“，作用是如果长时间不操作，以防1#和2#表有变动，进行数据的手工刷新。刚开始，是把功能做到这两个清单里面的，后来反映说想在同一个地方查询，不要打开多个文件。思路：先要将这两个文件的数据复制到同一个地方，于是先建了“数据”表，并新建一个模块。打开后，第一次点击”录入机床编号“时，先取数据；然后再建“汇总统计”表，在表中增一个按钮，命名为“录入机床编号”
复制链接

扫一扫