求大师完善跨工作簿提数据并求和代码

mmwwdd

Sub test()
Set d = CreateObject("scripting.dictionary")
Dim Mypath, Myname As String
Dim wb  As Workbook
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With Sheets("Sheet1")
   r = .Cells(.Rows.Count, 5).End(3).Row
   For i = 7 To r
      d(.Cells(i, 5).Value) = i
   Next
End With
Mypath = ThisWorkbook.Path & "\"
Myname = Dir(Mypath & Myname)
Do While Myname <> ""
    If ThisWorkbook.Name <> Myname Then
      Set wb = GetObject(Mypath & Myname)
        With wb.Sheets(1)
            brr = .Range("F6").CurrentRegion.Resize(, 15)
            For i = 2 To UBound(brr)
              If d.exists(brr(i, 2)) Then
                 For j = 10 To 15
                    求和 = brr(i, j) + 求和
                 Next
                 ws.Cells(d(brr(i, 2)), 15) = 求和
                 求和 = 0
              End If
             Next
         End With
     End If
  Myname = Dir
Loop

              
            
   
End Sub

mmwwdd

练习一下，老程序

zpy2

同心/ty 发表于 2023-5-26 23:14
老师，因基础表信息录入有不规范的地方，需求和那6列中有的单元格可能存在文本格式的数据，在我的事例中 ...

能存在文本格式的数据

最好能在输入环节避免，后期处理会比较方便

同心/ty

zpy2 发表于 2023-5-27 07:23
能存在文本格式的数据

最好能在输入环节避免，后期处理会比较方便

是的，因为基础数据表是各乡镇报上来的，有很多不规范。11楼代码我测试了一下，能规避文本数据，解决了我的问题，因为我的基础数据表不只是一个，若能在代码中再完善，运行时提示我去选择指定的基础信息表就好，好就更完美。谢谢老师。

同心/ty

mmwwdd 发表于 2023-5-27 03:42
Sub test()
Set d = CreateObject("scripting.dictionary")
Dim Mypath, Myname As String

老师，谢谢你的辛勤付出。代码很好，能规避文本数据，解决了我的问题。但我还有小要求不知能否帮我？因为我的基础数据表不只是一个，运行时提示我去选择指定某个基础信息表就好。

同心/ty

mmwwdd 发表于 2023-5-27 03:42
Sub test()
Set d = CreateObject("scripting.dictionary")
Dim Mypath, Myname As String

老师，还有一个问题就是我例子中基础信息表我删除了2个身份证号，在统计中能顺利配对求和。但我把基础信息表F列姓名也删除，也就是说基础信息表可能存在空行情况，那代码配对求和受到影响，不能顺利进行所有的。因为基础数据是来自各乡镇，信息录入不规范，能解决有空行，自动忽略就向下配对求和为好。

同心/ty

不知道为什么 发表于 2023-5-26 17:04
附件

老师，代码完美，规避了我2个问题，1.基础信息表可能存在空行问题，2.基础信息表O至T列中数据可能有文本格式的数据。代码完全配对求和顺利通过。老师，如果有时间能完善一下代码，我的要求是提示我选择指定信息表去配对就好，因为我可能有很多信息表，我每次操作只需选其中一个来配对求和。谢谢老师的辛勤付出。

longming3

不知道能不能解决你的问题，记得送上免费的花花

不知道为什么

同心/ty 发表于 2023-5-27 09:31
老师，代码完美，规避了我2个问题，1.基础信息表可能存在空行问题，2.基础信息表O至T列中数据可能有文本 ...

参考 18楼老师代码即可。

同心/ty

不知道为什么 发表于 2023-5-27 10:09
参考 18楼老师代码即可。

老师，我测试了18楼代码，能完成我要的效果，但不友好的地方是要增设辅助列6列，我表中F列-N列是有数据的。我还是想从你写的代码中完善。