难倒deepseek的VBA，谁能帮忙写下，谢啦！

fp168 · 发表于 2025-3-9 17:28

按客户统计各月的不良率，要求：
1. 写VBA代码
2. 统计结果如下格式，并生成新的工作表
4. 原始数据“客户”列，不带机种名，只抓取客户名即可，如三立P750W，只要抓取"三立"
5. 工单数的计算：数据表中工单号和工单数量有重复，一个工单号只需要对应一个工单数量
6. 不良数：即为报表内不良数累加

下格一个为原始数据，一个为输出格式要求：

2.rar (11.83 KB, 下载次数: 22)

shiruiqiang · 发表于 2025-3-9 18:51

本帖最后由 shiruiqiang 于 2025-3-9 18:53 编辑

全自动生成

shiruiqiang · 发表于 2025-3-9 18:55

本帖最后由 shiruiqiang 于 2025-3-9 19:05 编辑

仔细看了一下，上面代码自己再判断一下不重复的工单号就行，多了一个字典

ykcbf1100 · 发表于 2025-3-9 18:59

本帖最后由 ykcbf1100 于 2025-3-9 19:12 编辑

一键汇总
更新一下。。。

ykcbf1100 · 发表于 2025-3-9 19:01

本帖最后由 ykcbf1100 于 2025-3-9 19:14 编辑

Sub ykcbf() '//2025.3.9 排重汇总全表自动生成
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set d = CreateObject("Scripting.Dictionary")
ReDim brr(1 To 10000, 1 To 100)
On Error Resume Next
With Sheets("报表")
r = .Cells(Rows.Count, 1).End(3).Row
c = .UsedRange.Columns.Count
arr = .[a1].Resize(r, c)
End With
xm = [{"工单总数","不良总数","不良率"}]
m = 0
For i = 2 To UBound(arr)
s = stoc(arr(i, 1))
c = Month(arr(i, 6)) + 2
If Not d.exists(s) Then
m = m + 3
d(s) = m
For x = 1 To 3
brr(m - 3 + x, 2) = xm(x)
brr(m - 3 + x, 1) = s
Next
brr(m - 2, c) = arr(i, 4)
End If
r = d(stoc(arr(i, 1)))
brr(r - 1, c) = brr(r - 1, c) + Val(arr(i, 10))
Next
For j = 3 To 14
For i = 1 To UBound(brr) Step 3
brr(i + 2, j) = Format(brr(i + 1, j) / brr(i, j), "0.00%")
Next
Next
With Sheets("不良率统计")
.[a11].Resize(1000, 14).Clear
With .[a11].Resize(m, 14)
.Value = brr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Font
.Name = "微软雅黑"
.Size = 11
End With
End With
r = .Cells(Rows.Count, 1).End(3).Row
For i = r To 11 Step -1
Set Rng = .Cells(i, 1)
Set Rng1 = Rng.Offset(-1)
If Rng = Rng1 Then
.Cells(i, 1).Offset(-1).Resize(2).Merge
End If
Next
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

ＥＸＣＥＬ小子 · 发表于 2025-3-9 19:09

Sub GenerateSummaryReport()
Dim srcSheet As Worksheet, destSheet As Worksheet
Dim lastRow As Long, i As Long, m As Long, rowIndex As Long
Dim client, jobNumber As String, key
Dim jobQty As Double, defectQty As Double, monthNum As Long
Dim mainDict As Object, clientsDict As Object, jobDict As Object
Dim result() As Variant, data As Variant, clients() As Variant
Set srcSheet = ThisWorkbook.Worksheets("数据源") ' 原始数据所在工作表
Set destSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) ' 新建汇总表
destSheet.Name = "汇总结果"
lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
' 初始化主字典
Set mainDict = CreateObject("Scripting.Dictionary")
' 遍历原始数据
For i = 2 To lastRow
client = Left(Trim(srcSheet.Cells(i, 1).Value), 2)
jobNumber = CStr(srcSheet.Cells(i, 3).Value)
jobQty = CDbl(srcSheet.Cells(i, 2).Value)
defectQty = CDbl(srcSheet.Cells(i, 5).Value)
' 处理日期
If IsDate(srcSheet.Cells(i, 4).Value) Then
monthNum = Month(CDate(srcSheet.Cells(i, 4).Value))
Else
monthNum = 0 ' 无效日期跳过
End If
If monthNum < 1 Or monthNum > 12 Then GoTo NextRow
key = client & "|" & monthNum
If Not mainDict.Exists(key) Then
Set jobDict = CreateObject("Scripting.Dictionary")
jobDict(jobNumber) = 1
mainDict(key) = Array(jobDict, jobQty, defectQty)
Else
data = mainDict(key)
Set jobDict = data(0)
If Not jobDict.Exists(jobNumber) Then
data(1) = data(1) + jobQty
jobDict(jobNumber) = 1
End If
data(2) = data(2) + defectQty
mainDict(key) = data
End If
NextRow:
Next i
' 收集客户列表
Set clientsDict = CreateObject("Scripting.Dictionary")
For Each key In mainDict.Keys
clientsDict(Split(key, "|")(0)) = 1
Next
clients = clientsDict.Keys
' 准备结果数组 (客户数*3行 x 14列)
ReDim result(1 To 3 * clientsDict.Count, 1 To 14)
rowIndex = 1
For Each client In clients
' 客户名称
result(rowIndex, 1) = client
result(rowIndex + 1, 1) = client
result(rowIndex + 2, 1) = client
' 指标类型
result(rowIndex, 2) = "工单总数"
result(rowIndex + 1, 2) = "不良总数"
result(rowIndex + 2, 2) = "不良率"
' 填充月份数据
For m = 1 To 12
key = client & "|" & m
If mainDict.Exists(key) Then
data = mainDict(key)
result(rowIndex, m + 2) = data(1) ' 工单数
result(rowIndex + 1, m + 2) = data(2) ' 不良数
result(rowIndex + 2, m + 2) = data(2) / data(1) ' 不良率
Else
result(rowIndex, m + 2) = 0
result(rowIndex + 1, m + 2) = 0
result(rowIndex + 2, m + 2) = 0
End If
Next m
rowIndex = rowIndex + 3
Next client
' 写入结果
With destSheet
.Cells.Clear
.Range("A2").Resize(UBound(result, 1), UBound(result, 2)).Value = result
' 添加标题
.Range("A1:B1").Value = Array("客户名称", "指标")
For m = 1 To 12
.Cells(1, m + 2).Value = m & "月"
Next m
' 设置百分比格式
For i = 1 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(i, 2).Value = "不良率" Then
.Range(.Cells(i, 3), .Cells(i, 14)).NumberFormat = "0.00%"
End If
Next i
.Columns.AutoFit
End With
End Sub

复制代码

shiruiqiang · 发表于 2025-3-9 19:09

也不知道他在怎么统计？

ykcbf1100 · 发表于 2025-3-9 19:12

shiruiqiang 发表于 2025-3-9 19:09
也不知道他在怎么统计？

你应该是对的。对客户列原来我没看，现在更新了一下。

lyfegf · 发表于 2025-3-9 21:29

(
df[["客户", "工单数量", "工单号", "纳入日期"]]
.assign(
key=lambda d: d.客户.str.extract(r"([\u4e00-\u9fff]+)"),
月份=lambda d: d.纳入日期.dt.month.astype(str) + "月",
)
.groupby(["key", "工单号", "工单数量", "月份"])
.agg("count")
.reset_index()
.groupby(["key", "月份"])
.apply(
lambda d: pd.Series(
[
(total := d.工单数量.sum()),
(t := d.客户.sum()),
"{:.2f}%".format(t / total * 100),
],
index=["总数", "不良数", "不良率"],
).reset_index(name="数量"),
include_groups=False,
)
.reset_index(level=-1, drop=True)
.set_index(keys="index", append=True)
.unstack([-2], sort=False)
.pipe(lambda d: d.set_axis([x[-1] for x in d.columns],axis=1))
.reindex(columns=[f"{x}月" for x in range(1, 13)])
.rename_axis(index=['公司','指标'])
)

复制代码

perfect131 · 发表于 2025-3-9 21:36

提示: 作者被禁止或删除内容自动屏蔽

用户名		自动登录	找回密码
密码			免费注册

[求助] 难倒deepseek的VBA，谁能帮忙写下，谢啦！

评分

评分

评分

perfect131 perfect131 当前离线性别保密 UID 4313952 阅读权限 0 注册时间 2019-11-11 在线时间小时最后登录 1970-1-1 积分 3227 财富分享技术精华头像被屏蔽 TA的精华主题 TA的得分主题	发表于 2025-3-9 21:36 \| 显示全部楼层 [广告] ★ ReportLite:表哥表姐早下班神器，专治各种报表不服，拒绝无意义的重复劳动 ★ 提示: 作者被禁止或删除内容自动屏蔽

	回复举报