求助：对另外一个表格不打开进行几步操作

努力学习168

求助说明：见附件原数据说明，感谢帮助！

tanglf188

对当前工作簿处理，多个工作簿就需要遍历了

tanglf188

1. Sub test()
   
2.     Set Conn_object = CreateObject("ADODB.connection")
   
3.     Conn_object.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;IMEX=2;HDR=Yes';Data Source=" & ActiveWorkbook.FullName 'ActiveWorkbook.FullName可修改为指定工作簿
   
4.     Sele_str = "Select 数据1,数据2,IIF(数据3 Is Null,0,数据3)-IIF(数据4 Is Null,0,数据4),数据5,数据6,数据1&数据2 From [Sheet1$A:F]"
   
5.     Sheet1.Range("J2").CopyFromRecordset Conn_object.Execute(Sele_str)
   
6.     Conn_object.Close
   
7.     Set Conn_object = Nothing
   
8. End Sub
   

复制代码

努力学习168

tanglf188 发表于 2024-6-14 15:36

不能指定选择，只能再原文件操作这几步，是我不会

tanglf188

看注释，修改变量即可

3190496160

把代码写在一个新的文件中，然后，在这个新的文件中运行代码 ，按你说的步骤批量操作？？

3190496160

开始操作时要能自定义对其选择某表提示。不明白是啥意思？？？？

3190496160

Sub 批量操作()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(lj & f, 0)
        With wb.Worksheets(1)
            r = .Cells(Rows.Count, 3).End(xlUp).Row
            ar = .Range("a1:f" & r + 2)
            n = 1
            ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
            m = 0
            For j = 1 To UBound(ar, 2)
                If j <> 4 Then
                    m = m + 1
                    br(1, m) = ar(1, j)
                End If
            Next j
            For i = 2 To r
                If ar(i, 1) <> "" Then
                    n = n + 1
                    For j = 1 To 2
                        br(n, j) = ar(i, j)
                    Next j
                    br(n, 3) = ar(i, 3) - ar(i + 2, 4)
                    For j = 5 To 6
                        br(n, j - 1) = ar(i, j)
                    Next j
                    br(n, 6) = br(n, 1) & br(n, 2)
                End If
            Next i
            .[a1].CurrentRegion = Empty
            .[a1].Resize(n, UBound(br, 2)) = br
        End With
        wb.Close True
    End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

新建文件夹.rar (26.97 KB, 下载次数: 18)

2024-6-15 09:19 上传

点击文件名下载附件

所有需要操作的文件全部放到程序所在文件夹内