Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
楼主: hhxq001

[已解决]怎么才能保证有空字段也能取数

[复制链接]
 楼主| 发表于 2021-2-2 23:32 | 显示全部楼层
cutecpu 发表于 2021-2-2 21:22
您好,不是很懂這句的意思 →「不提取已有的序号,要求重新自动排序」

就是不提取工资表里的序号,重新自动编号
回复

使用道具 举报

发表于 2021-2-3 11:25 | 显示全部楼层
hhxq001 发表于 2021-2-2 23:32
就是不提取工资表里的序号,重新自动编号

Sub demo()


    Dim d As Object

    Set d = CreateObject("scripting.dictionary")

    With ActiveSheet
   
        ' 設定有幾列標題
        b = 12
        
        ' 設定標題行
        s = 2
        
        ' 建立標題名稱與所在列數的對應
        For i = 1 To b
            d(.Cells(s, i).Value) = i
        Next

        ' 讀取工資表到數組
        arr = Sheets("data").[a1].CurrentRegion
        
        ' 工資表資料筆數
        h = UBound(arr) - s
        
        ' 建立結果數組
        ReDim brr(1 To h, 1 To b)

        k = 0
        
        ' 從工資表第 4 行開始讀取
        For i = 4 To UBound(arr)
        
            ' 人員類別 不能為「遺屬」
            If arr(i, 2) <> "遺屬" Then
            
                ' 符合結果筆數加 1
                k = k + 1
               
                For j = 1 To UBound(arr, 2)
               
                    ' 符合結果標題的資料,存入結果數組
                    If d.exists(arr(2, j)) Then brr(k, d(arr(2, j))) = arr(i, j)
                    
                    ' 重新編號
                    If j = 1 Then brr(k, 1) = k
                    
                Next
            End If
        Next

        ' 清除先前資料結果
        clear
        
        ' 將結果數組填入「結果表」
        .[a4].Resize(h, b) = brr

    End With

End Sub

' 清除先前資料結果
Sub clear()
   ActiveSheet.UsedRange.Offset(3).clear
End Sub


祝順心,南無阿彌陀佛!

评分

参与人数 1学分 +2 收起 理由
hhxq001 + 2 学习了

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2021-2-13 22:20 | 显示全部楼层

根据需要又修改了表格样式和需求,麻烦给看看,怎么快速取数,注意中间的手工输入列数据不参与提取和清空哦

取数问题0213.zip (714.16 KB, 下载次数: 7)
回复

使用道具 举报

发表于 2021-2-14 15:37 | 显示全部楼层
本帖最后由 cutecpu 于 2021-2-14 15:47 编辑
hhxq001 发表于 2021-2-13 22:20
根据需要又修改了表格样式和需求,麻烦给看看,怎么快速取数,注意中间的手工输入列数据不参与提取和清空 ...

Sub demo()

   clear

   Dim month
   month = Range("I1").Value

   Set d = CreateObject("scripting.dictionary")

   orr = Sheets(month & "月其他收入").[a1].CurrentRegion
   For i = 6 To UBound(orr)
      d(orr(i, 5)) = i
   Next

   arr = Sheets(month & "月工資").[a1].CurrentRegion

   ReDim brr(1 To UBound(arr), 1 To 3)
   ReDim crr(1 To UBound(arr), 1 To 5)
   ReDim drr(1 To UBound(arr), 1 To 4)

   For i = 5 To UBound(arr)
      If arr(i, 4) <> "遺屬" Then
         r = r + 1
         Key = arr(i, 2)
         brr(r, 1) = Key
         brr(r, 2) = arr(i, 3)
         brr(r, 3) = arr(i, 5)
         crr(r, 1) = arr(i, 8)
         crr(r, 2) = arr(i, 9)
         crr(r, 3) = arr(i, 6)
         crr(r, 4) = arr(i, 7)
         crr(r, 5) = arr(i, 10)
         drr(r, 1) = "": drr(r, 2) = "": drr(r, 3) = "": drr(r, 4) = ""
         If d.exists(Key) Then
            drr(r, 1) = orr(d(Key), 7)
            drr(r, 2) = orr(d(Key), 8)
            drr(r, 3) = orr(d(Key), 9)
            drr(r, 4) = orr(d(Key), 10)
            d.Remove arr(i, 2)
         End If
      Else
         Exit For
      End If
   Next

   [D7].Resize(r, 3) = brr
   [Y7].Resize(r, 5) = crr
   [G7].Resize(r, 4) = drr

   ReDim Err(1 To d.Count(), 1 To 3)
   ReDim frr(1 To d.Count(), 1 To 4)

   For Each Key In d.keys()
      rr = rr + 1
      Err(rr, 1) = orr(d(Key), 5)
      Err(rr, 2) = orr(d(Key), 4)
      frr(rr, 1) = orr(d(Key), 7)
      frr(rr, 2) = orr(d(Key), 8)
      frr(rr, 3) = orr(d(Key), 9)
      frr(rr, 4) = orr(d(Key), 10)
   Next

   Range("D" & 7 + r).Resize(rr, 3) = Err
   Range("G" & 7 + r).Resize(rr, 4) = frr

End Sub

Sub clear()

   lastRow = Range("D65536").End(xlUp).Row
   If lastRow < 7 Then lastRow = 7
   Range("D7:P" & lastRow & ",Y7:AC" & lastRow).ClearContents

End Sub



祝順心,南無阿彌陀佛!

取数问题0213.rar

710.12 KB, 下载次数: 10

回复

使用道具 举报

 楼主| 发表于 2021-2-14 17:31 | 显示全部楼层
本帖最后由 hhxq001 于 2021-2-14 17:40 编辑
cutecpu 发表于 2021-2-14 15:37
Sub demo()

   clear

辛苦了,cutecpu版主。我试用后发现,其他收入表只能提取“其他收入”表的G列的数据,后面H--P列的数据无法提取,请看看怎么回事。

另外一月其他收入表中G列有57行数据,但是提取到一月汇总表中,只有47行?

哈哈,找到原因了,你的附加中中文是繁体的,我的是简体的,关键字不匹配的原因。
回复

使用道具 举报

发表于 2021-2-14 17:40 | 显示全部楼层
hhxq001 发表于 2021-2-14 17:31
辛苦了,cutecpu版主。我试用后发现,其他收入表只能提取“其他收入”表的G列的数据,后面H--P列的数据无 ...

您好,可能要請別人幫您看一下先
我回老家過年了~~
回复

使用道具 举报

 楼主| 发表于 2021-2-14 17:41 | 显示全部楼层
cutecpu 发表于 2021-2-14 17:40
您好,可能要請別人幫您看一下先
我回老家過年了~~

新年快乐,大侠
回复

使用道具 举报

 楼主| 发表于 2021-2-16 21:47 | 显示全部楼层
cutecpu 发表于 2021-2-14 15:37
Sub demo()

   clear

发现一个问题,如果1月工资表中,遗属人员不是全部排在最后,比如遗属在第一个序号,点击按钮就直接出错。如果遗属在第二个序号,则不会提取非遗属人员,怎么修改代码呢
回复

使用道具 举报

发表于 2021-2-17 18:27 | 显示全部楼层
hhxq001 发表于 2021-2-16 21:47
发现一个问题,如果1月工资表中,遗属人员不是全部排在最后,比如遗属在第一个序号,点击按钮就直接出错 ...

Sub demo()

   clear

   Dim month
   month = Range("I1").Value

   Set d = CreateObject("scripting.dictionary")

   orr = Sheets(month & "月其他收入").[a1].CurrentRegion
   For i = 6 To UBound(orr)
      d(orr(i, 5)) = i
   Next

   arr = Sheets(month & "月工資").[a1].CurrentRegion

   ReDim brr(1 To UBound(arr), 1 To 3)
   ReDim crr(1 To UBound(arr), 1 To 5)
   ReDim drr(1 To UBound(arr), 1 To 4)

   For i = 5 To UBound(arr)
      If arr(i, 1) = "" Then Exit For
      If arr(i, 4) = "遺屬" Then GoTo CONTINUE
      r = r + 1
      Key = arr(i, 2)
      brr(r, 1) = Key
      brr(r, 2) = arr(i, 3)
      brr(r, 3) = arr(i, 5)
      crr(r, 1) = arr(i, 8)
      crr(r, 2) = arr(i, 9)
      crr(r, 3) = arr(i, 6)
      crr(r, 4) = arr(i, 7)
      crr(r, 5) = arr(i, 10)
      drr(r, 1) = "": drr(r, 2) = "": drr(r, 3) = "": drr(r, 4) = ""
      If d.exists(Key) Then
         drr(r, 1) = orr(d(Key), 7)
         drr(r, 2) = orr(d(Key), 8)
         drr(r, 3) = orr(d(Key), 9)
         drr(r, 4) = orr(d(Key), 10)
         d.Remove Key
      End If

CONTINUE:
   Next

   [D7].Resize(r, 3) = brr
   [Y7].Resize(r, 5) = crr
   [G7].Resize(r, 4) = drr

   ReDim Err(1 To d.Count(), 1 To 3)
   ReDim frr(1 To d.Count(), 1 To 4)

   For Each Key In d.keys()
      rr = rr + 1
      Err(rr, 1) = orr(d(Key), 5)
      Err(rr, 2) = orr(d(Key), 4)
      frr(rr, 1) = orr(d(Key), 7)
      frr(rr, 2) = orr(d(Key), 8)
      frr(rr, 3) = orr(d(Key), 9)
      frr(rr, 4) = orr(d(Key), 10)
   Next

   Range("D" & 7 + r).Resize(rr, 3) = Err
   Range("G" & 7 + r).Resize(rr, 4) = frr

End Sub

Sub clear()

   lastRow = Range("D65536").End(xlUp).Row
   If lastRow < 7 Then lastRow = 7
   Range("D7:P" & lastRow & ",Y7:AC" & lastRow).ClearContents

End Sub

祝順心,南無阿彌陀佛!



评分

参与人数 1学分 +2 收起 理由
hhxq001 + 2 我和小伙伴都惊呆了

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2021-2-17 21:53 | 显示全部楼层
本帖最后由 hhxq001 于 2021-2-17 21:55 编辑
cutecpu 发表于 2021-2-17 18:27
Sub demo()

   clear

再问:我在其他收入表中插入了2列:银行账号、开户行后,再提取其他表里的数据,提取结果就向右偏移了,修改哪句才能纠正呢?

增加001.png
增加002.png

新问题0217.zip (727.31 KB, 下载次数: 4)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 22:16 , Processed in 0.553096 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表