恳请大师们帮忙看下这个求和的难题

qiongmei6 · 发表于 2024-2-8 21:47

我想在附件“非厨非聘用工”表格内求得一个代码，他根据“非厨非聘用工”表格的b列的单位，找出“基本资料”和c列一样的名字的单位，找出同单位d列非聘用工和e列非厨房的项目1到项目每个项目的总和，还有统计d列非聘用工和e列非厨房的人数显示在c列，“非厨非聘用工”里的c：q就是我希望代码执行后的结果，谢谢各位大神的帮忙

3190496160 · 发表于 2024-2-8 22:18

Sub 统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Dim br()
Set d = CreateObject("scripting.dictionary")
With Sheets("基本资料")
r = .Cells(Rows.Count, 3).End(xlUp).Row
If r < 2 Then MsgBox "基本资料为空！": End
ar = .Range("c1:t" & r)
End With
ReDim br(1 To UBound(ar), 1 To 16)
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
      If ar(i, 2) <> "聘用工" And ar(i, 2) <> "厨房" Then
         t = d(ar(i, 1))
         If t = "" Then
            k = k + 1
            d(ar(i, 1)) = k
            t = k
            br(k, 1) = ar(i, 1)
         End If
         br(t, 2) = br(t, 2) + 1
         For j = 5 To UBound(ar, 2)
            br(t, j - 2) = br(t, j - 2) + ar(i, j)
         Next j
      End If
End If
Next i
If k = "" Then MsgBox "没有需要汇总的数据！": End
With Sheets("非厨非聘用工")
rs = .Cells(Rows.Count, 3).End(xlUp).Row
If rs >= 5 Then .Range("b5:q" & rs) = Empty
.[b5].Resize(k, UBound(br, 2)) = br
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-2-8 22:19

Book1.rar (13.61 KB, 下载次数: 8)

qiongmei6 · 发表于 2024-2-8 23:09

非常感谢3190496160师傅的回答，我没表达清楚，导致您理解错我的意思了，我想在“非厨非聘用工”表格里求得一个代码，就是d列和e列没有厨房和非聘用工的各个项目数相加，c列统计这些相加的人数，但这个代码执行下去，他把厨房的数一起加进去了，我再把表格做的更清晰些，能再次麻烦您帮忙看下吗。再次谢谢您的帮忙

Again123456 · 发表于 2024-2-9 01:22

qiongmei6 发表于 2024-2-8 23:09
非常感谢3190496160师傅的回答，我没表达清楚，导致您理解错我的意思了，我想在“非厨非聘用工”表格里求得 ...

function test(){
let r= Sheets("基本资料").Cells(Rows.Count,"c").End(xlUp).Row
let c= Sheets("基本资料").Cells(1,Columns.Count).End(xlToLeft).Column
let arr =Sheets("基本资料").Range(Cells(1,3),Cells(r,c)).Value2
let obj = arr.reduce((p,c) => {
if (c[1] != "聘用工" && c[2] != "厨房"){
let k = c[0]
if (!p[k]){
p[k] = c.slice(4)
p[k] = c[0] ==null ? ["人数",...p[k]] :[1,...p[k]]
}else{
let tmp = c.slice(4)
tmp = [1,...tmp]
p[k] = p[k].map((v,i) => v + tmp[i])
}
return p
}else{
return p
}
},{})
let res = []
for( let k in obj ){
res.push([k,...obj[k]])
}
res [0][0] = null
Sheets("非厨非聘用工").Range("b4").CurrentRegion.ClearContents()
Sheets("非厨非聘用工").Range("b4").Resize(res.length,res[0].length).Value2 = res
}

复制代码

fzxba · 发表于 2024-2-9 07:04

本帖最后由 fzxba 于 2024-2-9 07:08 编辑

Book1.rar (16.41 KB, 下载次数: 6)

3190496160 · 发表于 2024-2-9 09:22

qiongmei6 发表于 2024-2-8 23:09
非常感谢3190496160师傅的回答，我没表达清楚，导致您理解错我的意思了，我想在“非厨非聘用工”表格里求得 ...

这句
If ar(i, 2) <> "聘用工" And ar(i, 2) <> "厨房" Then
修改为
If ar(i, 2) <> "聘用工" And ar(i, 3) <> "厨房" Then

3190496160 · 发表于 2024-2-9 09:24

Book1.rar (13.64 KB, 下载次数: 7)

grf1973 · 发表于 2024-2-9 10:18

JSA版本。。

liyangyunyangjy · 发表于 2024-2-9 10:20

Sub book1()

endrow1 = Sheets("非厨非聘用工").Cells(Rows.Count, "B").End(xlUp).Row
endrow2 = Sheets("基本资料").Cells(Rows.Count, "C").End(3).Row
endcol1 = Sheets("非厨非聘用工").Cells(4, Columns.Count).End(xlToLeft).Column
endcol2 = Sheets("基本资料").Cells(2, Columns.Count).End(xlToLeft).Column
For i = 5 To endrow1 '遍历目标表
      For j = 3 To endrow2 '遍历资料表
         If Sheets("基本资料").Cells(j, "C").Value = Sheets("非厨非聘用工").Cells(i, "B").Value _
         And Sheets("基本资料").Cells(j, "D").Value <> "聘用工" _
         And Sheets("基本资料").Cells(j, "E").Value <> "厨房" Then
            Sheets("非厨非聘用工").Cells(i, "C") = Val(Sheets("非厨非聘用工").Cells(i, "C").Value) + 1
            For k = 4 To endcol1
                  For p = 7 To endcol2
                     If Sheets("非厨非聘用工").Cells(4, k).Value = Sheets("基本资料").Cells(2, p).Value Then
                        Sheets("非厨非聘用工").Cells(i, k).Value = Val(Sheets("非厨非聘用工").Cells(i, k).Value) + Val(Sheets("基本资料").Cells(j, p).Value)
                     End If
                  Next
            Next
         End If
      Next
Next
End Sub

刚学习VBA,只能用多次循环的笨办法~

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

[求助] 恳请大师们帮忙看下这个求和的难题

评分

评分

评分

评分

评分