条件统计月份数量

MO888

满足条件的 月份数量


请大师  指导

duquancai

又来了         ？

duquancai

1. # -*- coding: utf-8 -*-
   
2. # version: Python 3.7.0
   
3. import pandas as pd
   
4. 
   
5. df = pd.read_excel('./副本.xlsm',sheet_name='操作记录',dtype={'编号':'string','批号':'string'})
   
6. result = df.groupby([df.loc[df['备注']!='追加','操作日期'].dt.to_period('M'),'批号']).agg(
   
7.     次数=('操作日期','count')
   
8. ).unstack(level=0,fill_value=0)
   
9. with pd.ExcelWriter('./分组聚合.xlsx',datetime_format='YYYY年MM月') as writer:
   
10.     result.to_excel(writer)

复制代码

cui26896

Sub test2()
Dim arr, brr, i&, j&, d, s, crr
Set d = CreateObject("Scripting.Dictionary")
arr = Sheets(1).UsedRange
For i = 2 To UBound(arr)
  s = Year(arr(i, 3)) & "年" & Month(arr(i, 3)) & "月"
'  Debug.Print s
  If Len(arr(i, 4)) = 0 And d.exists(arr(i, 3)) = False Then
    d(s) = 1
    Else
      d(s) = d(s) + 1
  End If
Next
brr = Sheets(2).Range("a2").CurrentRegion
ReDim crr(1 To 1, 1 To UBound(brr, 2))
For i = 1 To UBound(brr, 2)
  s = Year(brr(1, i)) & "年" & Month(brr(1, i)) & "月"
  If d.exists(s) Then
    crr(1, i) = d(s)
  End If
Next
Sheets(2).Range("a3").Resize(1, UBound(brr, 2)) = crr
End Sub

cui26896

又要审核，只有发附件了
条件统计月份数量.zip (17.74 KB, 下载次数: 23)

2020-5-31 17:05 上传

点击文件名下载附件

microyip

duquancai 发表于 2020-5-31 16:25

又跑来下来了？想做辅助吗？程咬金，哈哈

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, p, m, n
  arr = Sheets("操作记录").[a1].CurrentRegion.Offset(1).Resize(, 4).Value
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 4) <> "追加" Then
      m = m + 1
      arr(m, 3) = arr(i, 3): arr(m, 4) = Format(arr(i, 3), "yyyy年mm月")
    End If
  Next
  Call bsort(arr, 1, m, 3, 4, 4)
  ReDim brr(1 To 2, 1 To m)
  For i = 1 To m
    If arr(i, 4) <> arr(i + 1, 4) Then
      n = n + 1
      brr(1, n) = arr(i, 4): brr(2, n) = i - p
      p = i
    End If
  Next
  With Sheets("月度统计")
    .Rows(2).Resize(2).ClearContents
    .[a2].Resize(2, n) = brr
  End With
End Sub

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) > arr(j + 1, key) Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
    Next
  Next
End Function

MO888

一把小刀闯天下 发表于 2020-5-31 17:33
Option Explicit

Sub test()

非常感谢大师的帮助  

MO888

microyip 发表于 2020-5-31 17:28
又跑来下来了？想做辅助吗？程咬金，哈哈

我刚自学VBA 一个月 谢谢贴吧里的大师指导 我进步很快

MO888

duquancai 发表于 2020-5-31 16:04
又来了         ？

我是新人小白 大师你的代码我看不懂太高深 只能寻求一些简单易懂的  非常感谢贴吧里的各位大师指导