数据提取

ba3259878266

文件夹里有多个工作表 "A (1)  A (2) )  A (3)   A (4)   A (5)   A (6)   A (7)  A (8)" 怎样提取各个工作表Sheet1里面相同位置的数据  比如 E2:E7 O2:O7 二个区域  谢谢各位老师帮忙

taller

论坛中这种示例很多，楼主没有附件，大家没法测试代码

ba3259878266

taller 发表于 2025-3-25 10:25
论坛中这种示例很多，楼主没有附件，大家没法测试代码

谢谢师傅 这个附件

ba3259878266

taller 发表于 2025-3-25 10:25
论坛中这种示例很多，楼主没有附件，大家没法测试代码

师傅谢谢  麻烦你看看附件

limonet

VBA的数组、SQL的union all、PQ的table.skip、python的iloc

taller

1. Option Explicit
   
2. Sub Demo()
   
3.     With Application
   
4.         .ScreenUpdating = False
   
5.     End With
   
6.     Dim ws As Worksheet
   
7.     Set ws = ThisWorkbook.Sheets("Sheet1")
   
8.     ws.Cells.Clear
   
9.     Dim cell As Range
   
10.     Set cell = ws.Range("A1")
    
11.     Dim folderPath As String
    
12.     folderPath = ThisWorkbook.Path
    
13.     Dim fileName As String
    
14.     fileName = Dir(folderPath & "\*.xls*")
    
15.     Do While fileName <> ""
    
16.         If fileName <> ThisWorkbook.Name Then
    
17.             Dim wb As Workbook
    
18.             Set wb = Workbooks.Open(folderPath & "" & fileName)
    
19.             wb.Sheets("Sheet1").Range("L2:L7").Copy cell
    
20.             wb.Sheets("Sheet1").Range("O2:O7").Copy cell.Offset(0, 1)
    
21.             Set cell = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0)
    
22.             wb.Close False
    
23.         End If
    
24.         fileName = Dir
    
25.     Loop
    
26.     With Application
    
27.         .ScreenUpdating = True
    
28.     End With
    
29.     MsgBox "Done"
    
30. End Sub
    

复制代码

taller

ba3259878266

taller 发表于 2025-3-25 11:04

谢谢师傅 麻烦发附件过来  

ba3259878266

taller 发表于 2025-3-25 10:25
论坛中这种示例很多，楼主没有附件，大家没法测试代码

谢谢版主 只能复制粘贴

ba3259878266

taller 发表于 2025-3-25 10:25
论坛中这种示例很多，楼主没有附件，大家没法测试代码

版主谢谢 能回附件吗  谢谢