|
|
本帖最后由 cmo9020 于 2023-1-12 20:14 编辑
各位导师们您好,我现在遇到一问题
在sheet2 A1单元格要设置年份
月份我弄好了，但周数一直没办法完成
请问一下周数要如何修改代码？
周数有点搞不定....
能不能麻烦各位导师帮忙一下,谢谢您
Sub TEST3333()
Dim d As Object, dc As Object
Dim ar As Variant, br As Variant
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Tt = Timer
With Sheet1
r = .Cells(Rows.Count, 3).End(xlUp).Row
ar = .Range("a1:n" & r)
End With
With Sheet2
nf = .[o1]
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs > 3 Then
.Range("o4:y" & rs).Borders.LineStyle = 0
.Range("o4:y" & rs) = 0
End If
u = UBound(ar) + 4
br = .Range("o3:y" & u)
For j = 2 To UBound(br, 2)
If Trim(br(1, j)) <> "" Then
d(Trim(br(1, j))) = j
End If
Next j
k = 1
For i = 15 To UBound(ar)
If Year(ar(i, 3)) = nf Then
week = Int((DatePart("W", ar(i, 3)) - 1) / 7) + 1
For j = 3 To rs
If week = Sheet2.Cells(j, 1).Value Then
If Trim(ar(i, 1)) <> "" Then dc(Trim(ar(i, 1))) = dc(Trim(ar(i, 1))) + 1
If Trim(ar(i, 1)) <> "" And Trim(ar(i, 12)) <> "" Then
T = d(Trim(ar(i, 12)))
If T = "" Then
k = k + 1
d(Trim(ar(i, 12))) = k
T = k
br(k, 1) = ar(i, 12)
End If
lh = d(Trim(ar(i, 1)))
If lh <> "" Then
br(T, lh) = br(T, lh) + 1
End If
End If
End If
Next j
End If
Next i
k = k + 1
br(k, 1) = "统计"
br(k + 1, 1) = " 每周检验总数"
br(k + 2, 1) = " 不良品"
For j = 2 To UBound(br, 2)
br(k, j) = Application.Sum(Application.Index(br, 0, j))
lh = d(Trim(br(1, j)))
br(k + 1, j) = dc(Trim(br(1, j)))
If br(k + 1, j) = 0 Then
br(k + 2, j) = 0
Else
br(k + 2, j) = br(k, j) / br(k + 1, j)
End If
Next j
.[o3].Resize(k + 2, UBound(br, 2)) = br
.Cells(k + 16, 2).Resize(1, 10).NumberFormatLocal = "0.00%"
.Range("o4:y" & r + 3).Borders.LineStyle = 2
End With
Set d = Nothing
Set dc = Nothing
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-1-10 21:35
楼主
