求助提取身份证和收入

武松打鼓 · 发表于 2021-10-25 23:28

想从2个表中提取身份证和收入到汇总表中，用代码如何实现？请高手帮忙，要求见附件吧

提取身份证问题.zip (323.62 KB, 下载次数: 42)

liulang0808 · 发表于 2021-10-26 07:35

Sub 按钮393_Click()
Dim arr(1 To 9999, 4 To 16)
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.Calculation = xlAutomatic
Sheets("汇总").Select
r = Cells(Rows.Count, 4).End(3).Row
Range("d7:p" & r).ClearContents
r = 0
For Each sh In Sheets
      If InStr(sh.Name, "工资") > 0 Then
         brr = sh.UsedRange
         For j = 5 To UBound(brr)
            If Len(brr(j, 2)) <> 0 Then
                  If Not d.exists(brr(j, 2) & "") Then
                     r = r + 1
                     arr(r, 4) = brr(j, 2)
                     arr(r, 5) = brr(j, 3)
                     arr(r, 6) = brr(j, 6)
                     d(brr(j, 2) & "") = r
                  End If
            End If
         Next j
      End If
Next sh
For Each sh In Sheets
      If InStr(sh.Name, "其他收入") > 0 Then
         brr = sh.UsedRange
         For j = 9 To UBound(brr)
            If Len(brr(j, 5)) <> 0 Then
                  If Not d.exists(brr(j, 5) & "") Then
                     r = r + 1
                     arr(r, 4) = brr(j, 5)
                     arr(r, 5) = brr(j, 4)
                     For i = 1 To 10
                        arr(r, i + 6) = Val(brr(j, i + 8))
                     Next i
                  Else
                     x = d(brr(j, 5) & "")
                     For i = 1 To 10
                        arr(x, i + 6) = Val(arr(x, i + 6)) + Val(brr(j, i + 8))
                     Next i
                  End If
            End If
         Next j
      End If
Next sh
[d7].Resize(r, 13) = arr
Application.Calculation = xlManual
Application.ScreenUpdating = True
End Sub

liulang0808 · 发表于 2021-10-26 07:36

.........................

武松打鼓 · 发表于 2021-10-26 08:39

liulang0808 发表于 2021-10-26 07:36
.........................

会把表头字段删除，咋回事呢

yzyyyyyyy · 发表于 2021-10-26 10:12

Sheets("汇总").Select
r = Cells(Rows.Count, 1).End(3).Row

武松打鼓 · 发表于 2021-10-26 11:00

yzyyyyyyy 发表于 2021-10-26 10:12
Sheets("汇总").Select
r = Cells(Rows.Count, 1).End(3).Row

谢谢帮忙。。。。。

liulang0808 · 发表于 2021-10-26 11:42

武松打鼓发表于 2021-10-26 08:39
会把表头字段删除，咋回事呢

Range("d7:p" & r + 7).ClearContents

武松打鼓 · 发表于 2021-10-26 14:31

liulang0808 发表于 2021-10-26 11:42
Range("d7:p" & r + 7).ClearContents

If Not d.exists(brr(j, 2) & "") Then

这一句不懂意思，请赐教

武松打鼓 · 发表于 2021-10-26 15:00

liulang0808 发表于 2021-10-26 07:36
.........................

我增加了提取工资表三险一金的列，却提取不出来，请指点。

再提问.zip (332.26 KB, 下载次数: 6)

liulang0808 · 发表于 2021-10-26 18:47

武松打鼓发表于 2021-10-26 15:00
我增加了提取工资表三险一金的列，却提取不出来，请指点。

表格格式变化了，楼主结合原来的代码调整下对应关系吧

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

[求助] 求助提取身份证和收入

评分

评分

评分

最新热点 /1