[已解决]请问如何用VBA读取子表格中的区域数据？

chrislt52346

请问想读取子表格中“银联”的B3：E58读取到母表格中该如何读取？

最佳答案

月排行榜 / 总排行榜

grf1973

2014-5-23 15:46

ThisWorkbook.Sheets("sheet1").Cells(i, 2).resize(n,1) = application.transpose(xl.Sheets("银联").Range("B2").resize(1,n))
其中n是区域的行数。
是不是这个意思？

跳转到最佳答案楼层

grf1973

1. Sub 导入文件()
   
2.     Application.ScreenUpdating = False
   
3.     Dim filename, wb As Workbook, Sht As Worksheet
   
4.     filename = Dir(ThisWorkbook.Path & "\子表格\*.xls")
   
5.     Set sh = ActiveSheet
   
6.     Do While filename <> ""
   
7.         fn = ThisWorkbook.Path & "\子表格" & filename
   
8.         Set wb = Workbooks.Open(fn)
   
9.         Set Sht = wb.Worksheets("银联")
   
10.         Set xrng = Sht.UsedRange.Find("制表", lookat:=xlPart)
    
11.         If Not xrng Is Nothing Then
    
12.             je = xrng.Offset(-1, 0)
    
13.             r = sh.[a65536].End(3).Row + 1
    
14.             sh.Cells(r, 1) = filename
    
15.             sh.Cells(r, 2) = je
    
16.         End If
    
17.         wb.Close False
    
18.         filename = Dir
    
19.     Loop
    
20.     Set Sht = Nothing
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    

复制代码

grf1973

请看附件。

chrislt52346

grf1973 发表于 2014-5-23 14:19
请看附件。

您好，谢谢您的解答。是我没表达清楚，我是想把B3到E58中间的所有数值都表现出来，形成一个表格。谢谢您

grf1973

你该做个模拟结果表的。。。。把所有的行在一张表上列出来？

grf1973

难道是这样？

1. Sub 导入文件()
   
2.     Application.ScreenUpdating = False
   
3.     Dim filename, wb As Workbook, Sht As Worksheet
   
4.     filename = Dir(ThisWorkbook.Path & "\子表格\*.xls")
   
5.     Set sh = ActiveSheet
   
6.     sh.[a2:b65536].ClearContents
   
7.     Do While filename <> ""
   
8.         fn = ThisWorkbook.Path & "\子表格" & filename
   
9.         Set wb = Workbooks.Open(fn)
   
10.         Set Sht = wb.Worksheets("银联")
    
11.         Set xrng = Sht.UsedRange.Find("制表", lookat:=xlPart)
    
12.         If Not xrng Is Nothing Then
    
13.             r1 = xrng.Offset(-2, 0).Row: n = r1 - 4 + 1
    
14.             r = sh.[a65536].End(3).Row + 1
    
15.             sh.Cells(r, 1).Resize(n, 1) = filename
    
16.             sh.Cells(r, 2).Resize(n, 1) = Sht.Cells(4, xrng.Column).Resize(n, 1).Value
    
17.         End If
    
18.         wb.Close False
    
19.         filename = Dir
    
20.     Loop
    
21.     Set Sht = Nothing
    
22.     Application.ScreenUpdating = True
    
23. End Sub
    

复制代码

grf1973

最后加一句删除空行的。

1. Sub 导入文件()
   
2.     Application.ScreenUpdating = False
   
3.     Dim filename, wb As Workbook, Sht As Worksheet, sh As Worksheet
   
4.     filename = Dir(ThisWorkbook.Path & "\子表格\*.xls")
   
5.     Set sh = ActiveSheet
   
6.     sh.[a2:b65536].ClearContents
   
7.     Do While filename <> ""
   
8.         fn = ThisWorkbook.Path & "\子表格" & filename
   
9.         Set wb = Workbooks.Open(fn)
   
10.         Set Sht = wb.Worksheets("银联")
    
11.         Set xrng = Sht.UsedRange.Find("制表", lookat:=xlPart)
    
12.         If Not xrng Is Nothing Then
    
13.             r1 = xrng.Offset(-2, 0).Row: n = r1 - 4 + 1
    
14.             r = sh.[a65536].End(3).Row + 1
    
15.             sh.Cells(r, 1).Resize(n, 1) = filename
    
16.             sh.Cells(r, 2).Resize(n, 1) = Sht.Cells(4, xrng.Column).Resize(n, 1).Value
    
17.         End If
    
18.         wb.Close False
    
19.         filename = Dir
    
20.     Loop
    
21.     Set Sht = Nothing
    
22.     sh.Range("b:b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp
    
23.     Application.ScreenUpdating = True
    
24. End Sub

复制代码

chrislt52346

grf1973 发表于 2014-5-23 15:02
最后加一句删除空行的。

谢谢您，其实我想知道的是

Sub t()
  Dim s$, arr, brr, i&, FileName$, xl As Object
  Application.ScreenUpdating = False
  i = 2
  Do Until Len(Cells(i, 1).Value) = 0
    FileName = Dir(ThisWorkbook.Path & "\" & Cells(i, 1))
    If FileName <> "" Then
      Set xl = GetObject(ThisWorkbook.Path & "\" & FileName)
      ThisWorkbook.Sheets("sheet1").Cells(i, 2) = xl.Sheets("银联").Range("B2")
      ThisWorkbook.Sheets("sheet1").Cells(i, 3) = xl.Sheets("银联").Range("C2")
      ThisWorkbook.Sheets("sheet1").Cells(i, 4) = xl.Sheets("银联").Range("D2")
      xl.Close 0
      Set xl = Nothing
    End If
    i = i + 1
  Loop
  Application.ScreenUpdating = True
End Sub
如何把中间的三句      ThisWorkbook.Sheets("sheet1").Cells省略，变成一句读取一个区域才是我想求助的答案。

grf1973

ThisWorkbook.Sheets("sheet1").Cells(i, 2).resize(n,1) = application.transpose(xl.Sheets("银联").Range("B2").resize(1,n))
其中n是区域的行数。
是不是这个意思？

chrislt52346

grf1973 发表于 2014-5-23 15:46
ThisWorkbook.Sheets("sheet1").Cells(i, 2).resize(n,1) = application.transpose(xl.Sheets("银联").Rang ...

谢谢

ThisWorkbook.Sheets("sheet1").Cells(i, 2).resize(n,1) = application.transpose(xl.Sheets("银联").Range("B2").resize(1,n)) 其中n是区域的行数。

语句最后的N表示的是列吧？