请教各位大佬如何用VBA提取指定表格中的数据向右填充到子表中？

hzs1111111 · 发表于 2023-4-12 21:27

每个员工的工资需要进行汇总，方便查看每个月的工资发放情况，如何通过vba一键生成本月的汇总表，第二个月又需要添加一次

hzs1111111 · 发表于 2023-4-13 10:49

求助大佬帮忙呢

lihaosh · 发表于 2023-4-13 10:56

做个透视表不是更快？

吴中泉 · 发表于 2023-4-13 11:15

hzs1111111 发表于 2023-4-13 10:49
求助大佬帮忙呢

每个月的工资中人员会增加或减少吗?姓名先后顺序是否会变?如果不变,直接复制,一月就一次,不难

lihaosh · 发表于 2023-4-13 11:19

Sub SumSalary()
Dim ws As Worksheet
Set ws = Worksheets("总表")
Dim lrow As Long
lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
Dim salaryCol As String
salaryCol = "C"
If ws.Range(salaryCol & "1").Value <> "1月工资" Then
Select Case ws.Range(salaryCol & "1").Value
Case "2月工资"
salaryCol = "D"
Case "3月工资"
salaryCol = "E"
End Select
End If
Dim lastRow As Long
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
Dim rg As Range
Dim deptName As String
Dim jobTitle As String
Dim salary As Double
Dim i As Long
If ws.Cells(1, "C").Value = "1月工资" Then
ws.Range("C1").EntireColumn.Delete Shift:=xlToLeft
End If
ws.Range("C1").Value = salaryCol
For i = 2 To lastRow
deptName = ws.Cells(i, "A").Value
jobTitle = ws.Cells(i, "B").Value
salary = ws.Cells(i, salaryCol).Value
Set rg = ws.Range("A2:C" & lrow).Find(what:=deptName, lookat:=xlWhole)
Do Until rg Is Nothing
If rg.Offset(0, 1).Value = jobTitle Then
rg.Offset(0, salaryColRange(salaryCol) - 3).Value = rg.Offset(0, salaryColRange(salaryCol) - 3).Value + salary
Exit Do
Else
Set rg = ws.Range("A" & rg.Row + 1 & ":C:C" & lrow).Find(what:=deptName, lookat:=xlWhole)
End If
Loop
If rg Is Nothing Then
lrow = lrow + 1
ws.Range("A" & lrow).Value = deptName
ws.Range("B" & lrow).Value = jobTitle
ws.Range("C" & lrow).Value = 0
ws.Range(salaryCol & lrow).Value = salary
End If
Next i
End Sub
Function salaryColRange(col As String) As Long
salaryColRange = Asc(col) - 64
End Function

复制代码

lihaosh · 发表于 2023-4-13 11:20

猜着做的题，不清楚具体的需求是什么？

hzs1111111 · 发表于 2023-4-13 11:24

吴中泉发表于 2023-4-13 11:15
每个月的工资中人员会增加或减少吗?姓名先后顺序是否会变?如果不变,直接复制,一月就一次,不难

人员会有所变动每个月需要匹配一次如果少了就删除多了就增加感谢大佬非常感谢

hzs1111111 · 发表于 2023-4-13 11:25

lihaosh 发表于 2023-4-13 11:20
猜着做的题，不清楚具体的需求是什么？

每个月人员会有可能会变动

hzs1111111 · 发表于 2023-4-13 12:23

lihaosh 发表于 2023-4-13 11:19

感谢，运行提示错误

吴中泉 · 发表于 2023-4-13 14:10

hzs1111111 发表于 2023-4-13 11:25
每个月人员会有可能会变动

编了一个,你试用一下:好用送花

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

[求助] 请教各位大佬如何用VBA提取指定表格中的数据向右填充到子表中？