能否帮忙改进一下代码？

3190496160

sample.rar (25.41 KB, 下载次数: 9)

2024-6-17 08:33 上传

点击文件名下载附件

3190496160

制作附件太过于马虎了事，代码仅供参考

quqiyuan

代码参考。。。
Sub 导入数据()
    Dim p$, f$, Wb As Workbook, Arr, r, crr, brr, s, i, j, d
    Set d = CreateObject("scripting.dictionary")
    Dim aa As String, Falg As Boolean
    aa = InputBox("请输入文件名：", "导入数据", 36)
    If StrPtr(aa) <> 0 Then
        p = ThisWorkbook.Path
        f = Dir(p & "\" & aa & ".xls*")
        If f <> "" Then
            Set Wb = Workbooks.Open(p & "\" & f)
            Arr = Wb.Sheets(1).Range("A2:h40").Value
            Wb.Close False
            Falg = True
        End If
        If Falg Then
            Application.ScreenUpdating = False
            r = Sheet1.Cells(Rows.Count, 2).End(3).Row
            brr = Sheet1.Range("A3:h" & r)
            For i = 1 To UBound(brr)
                For j = 1 To UBound(brr, 2)
                    s = s & brr(i, j)
                Next
                d(s) = ""
                s = Empty
            Next
            ReDim crr(1 To UBound(brr, 2))
            For i = 1 To UBound(Arr)
                For j = 1 To UBound(Arr, 2)
                    s = s & Arr(i, j)
                    crr(j) = Arr(i, j)
                Next
                If Not d.exists(s) Then
                r = Sheet1.Cells(Rows.Count, 2).End(3).Row + 1
                Sheet1.Cells(r, 1).Resize(, UBound(brr, 2)) = crr
                End If
                s = Empty
            Next
            Application.ScreenUpdating = True
        Else
            MsgBox "没有找到文件名为“" & aa & "”文件。"
        End If
    End If
End Sub

vbahappy

感谢各位大神的无私帮助，信息量太大，我再慢慢消化和整理一下

taller

vbahappy 发表于 2024-6-17 07:03
老师，有些问题呀，运行代码显示查不到36文件

导入部分是你原来的代码，我只增加了去重代码

包含代码的工作簿需要和36文件在同一目录中

LIUZHU

数据不规范吧，汇总表是4，需要导入的表是04，这到底是一致还是不一致？