年+周数解答...失眠好几天睡不太着

cmo9020

TEST1.rar (180.21 KB, 下载次数: 10)

2023-1-12 23:33 上传

点击文件名下载附件

请导师帮忙一下，原本代码没有加入年查询,变成混在一起目前要修改sub Week () 是周数，
输入年份是在sheet2 A1单元格，
然后把sheet1的相同年份资料给带到sheet2 
可以个别查询2022,2023年的周数，去带出sheet1 L列的异常事项

月份和周数代码还有正确解答都在"代码"工作表
月份是修改过后的，可以执行
要是有看不懂地方,希望导师们可以把SHEET2 a4:aa4以下数据做清空去执行代码看看，应该看的出来我说的意思

但周数改不出来
周数代码目前放回春风导师给的原代码
希望以原来代码下去做周数的修改,不然我会很错乱
麻烦请导师帮忙看一下,谢谢各位....我困扰好几天都睡不太着,请各位帮帮忙







Sub WEEK()
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 Sheets("Sheet1")
    r = .Cells(Rows.count, 1).End(xlUp).Row
    ar = .Range("B1:N" & r)
End With
With Sheets("Sheet2")
     rs = .Cells(Rows.count, 15).End(xlUp).Row
     If rs > 3 Then
        .Range("o4:aa" & rs).Borders.LineStyle = 0
        .Range("o4:aa" & rs) = 0
    End If
        u = UBound(ar)
        br = .Range("o3:aa" & 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 = 2 To UBound(ar)
            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, 11)) <> "" Then
                t = d(Trim(ar(i, 11)))
                If t = "" Then
                    k = k + 1
                    d(Trim(ar(i, 11))) = k
                   t = k
                    br(k, 1) = ar(i, 11)
                End If
                lh = d(Trim(ar(i, 1)))
                If lh <> "" Then
                    br(t, lh) = br(t, lh) + 1
                End If
            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
                br(k + 1, 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 + 4, 2).Resize(1, 32).NumberFormatLocal = "0.0%"
        .[o3].Resize(k + 2, UBound(br, 2)).Borders.LineStyle = 2
End With
Set d = Nothing
Set dc = Nothing
End Sub

ykcbf1100

既然是春风老师的代码，最好还是春风老师来改。

洋务德雷

上个问题中已经回答过，你再看一下，是否满足需要？

tanglf188

只有月份没有年份，这种数据看了就头大，现在可以根据大小判断年份，但等有相同的月份了怎么办？取出的数据还是有问题。

grf1973

加句判断而已。

ykcbf1100

grf1973 发表于 2023-1-13 13:26
加句判断而已。

不是年份，他说的是周数。

ykcbf1100

我写的代码你看不明白，那我就用春风老师的代码改一个吧。

grf1973

上个代码简单一点的。

ykcbf1100

grf1973 发表于 2023-1-13 14:09
上个代码简单一点的。

别说代码简单，SQL好多人不会，我也不会。

cmo9020

ykcbf1100 发表于 2023-1-13 14:02
我写的代码你看不明白，那我就用春风老师的代码改一个吧。

谢谢ykcbf1100老师
我有试着改成i,2...就是没成功少了val引用nf
谢谢您们各位,谢谢，新年快乐,事事顺心