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

同心/ty

longming3 发表于 2023-5-27 11:31
代码结果中统计表是按你设计好的表格格式做的，你增加或减少列都可以，代码中稍微修改一下就可以了。
代 ...

老师，For k = 15 To 20，语句是表达什么?

同心/ty

不知道为什么 发表于 2023-5-27 11:23
。。。。。。。。。

老师，将你的代码投入工作中应用，出现以下问题，比如基础表里求和为0.5提取变成0，0.51变成1.0，1.5变成2.0.等现象，说是四舍五入吧，那0.5又反馈的是0，真搞不懂。老师是不还要有一个约定的条件。测试件都是整数，反应不出问题，我那基础信息表数据都是2位或3位小数的。

不知道为什么

同心/ty 发表于 2023-5-27 16:42
老师，将你的代码投入工作中应用，出现以下问题，比如基础表里求和为0.5提取变成0，0.51变成1.0，1.5变成 ...

修改下变量声明的类型。s 变量改为单精度。

同心/ty

不知道为什么 发表于 2023-5-27 17:13
修改下变量声明的类型。s 变量改为单精度。

已重新发贴，得到整改代码。

同心/ty

不知道为什么 发表于 2023-5-27 17:13
修改下变量声明的类型。s 变量改为单精度。

同心/ty

longming3 发表于 2023-5-27 11:39
只要计算结果改成这样即可

老师，在应用过程中，基础表身份证号后一位有部份人“x”是小写，而在统计表中又是大写“X”，如何加一段代码，忽略大写字母的匹配？盼回复。

同心/ty

同心/ty 发表于 2024-6-19 12:01
老师，在应用过程中，基础表身份证号后一位有部份人“x”是小写，而在统计表中又是大写“X”，如何加一段 ...

Sub test3()  更新规避身份证号X大小写问题
    Application.ScreenUpdating = False '关闭屏幕更新
    Range("q7:q300000").Select
    Selection.ClearContents
   
   Columns("e:e").Select
   Range("e7").Activate
   Selection.Replace What:="x", Replacement:="X"  '身份证字母小写改大写



    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        m = .[d65536].End(3).Row
        ar = .Range("a7").Resize(m - 6, 18)
        For i = 1 To UBound(ar)
            If Len(ar(i, 4)) Then
                gjz = ar(i, 4) & ar(i, 5) '关键字为姓名+身份证号
                d(gjz) = i '记录行号
            End If
        Next
   
   
        Dim files
        Dim wb As Workbook
        Dim sht As Worksheets
        files = Application.GetOpenFilename(filefilter:="EXCEL 工作表(*.xlsx;*.xlsm;*.xls),*.xlsx;*.xlsm;*.xls", Title:="请选择要导入的工作簿", MultiSelect:=True) '选取，可以选多个excel文件
        If Not IsArray(files) Then '如果按取消，没有选择的时候，退出程序
            MsgBox "没有选定工作薄！～"
            Exit Sub
        End If
        For i = UBound(files) To LBound(files) Step -1 '循环
            Set wb = Workbooks.Open(files(i)) '依次打开
            With wb.ActiveSheet
            
             Columns("g:g").Select
            Range("g7").Activate
            Selection.Replace What:="x", Replacement:="X"  '身份证字母小写改大写

            
                m = .[f65536].End(3).Row
                br = .Range("a7").Resize(m - 6, 21)
                For j = 1 To UBound(br)
                    If Len(br(j, 6)) Then
                        gjz = br(j, 6) & br(j, 7)
                        If d.exists(gjz) Then
                        For k = 15 To 20
                           ar(d(gjz), 17) = ar(d(gjz), 17) + Val(br(j, k))
                           Next
                        End If
                    End If
                Next
            End With
            wb.Close False
        Next
        
        .Range("a7").Resize(UBound(ar), UBound(ar, 2)) = ar
    End With
    Application.ScreenUpdating = True    '打开屏幕更新
End Sub