批量相减的问题

杨小妹

附件 提量相减附件.rar (51.53 KB, 下载次数: 8)

2024-12-5 18:50 上传

点击文件名下载附件

谢谢老师！

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, i&, r&, strFileName$, strPath$
   
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path & "\"
    strFileName = Dir(strPath & "*.xls")
    Do Until strFileName = ""
        If strFileName <> ThisWorkbook.Name Then
            With Workbooks.Open(strPath & strFileName)
                With .Worksheets(2)
                    r = .Cells(.Rows.Count, "A").End(xlUp).Row
                    ar = .Range("A1:C" & r).Value
                    ReDim br(1 To UBound(ar), 0)
                    For i = 2 To UBound(ar) Step 3
                        br(i, 0) = ar(i, 1) - ar(i - 1, 1)
                    Next i
                    [D1].Resize(UBound(br)) = br
                End With
                .Close True
            End With
        End If
        strFileName = Dir
    Loop

    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

蓝桥玄霜

相减的例子：

杨小妹

gwjkkkkk 发表于 2024-12-5 20:19
请参考。。。

老师你好，谢谢帮助。我下载附件，然后解压。把附件中的工作薄 1   2  中的D列答案删除。然后用程序执行，结果，一点反应都没有。好象少了点关联。

gwjkkkkk

[D1].Resiz前面加个点，即.[D1].Resiz