[已解决]如何批量提取工作薄中某个工作表中的固定行的不连续数据

wrzy012345 · 发表于 2014-4-17 11:35

如题，如何批量提取工作薄中某个工作表中的固定行的不连续数据，工作薄的基本格式是一样的，只是需要提取内容的表3中的打印范围是不一样的，我想将一个文件夹中的若干个工作薄中的表3中的Q列中的数据提取出来，并且Q列中有合并的单元格存在，按照工作薄的名称顺序汇总到一张表上，不知道该如何编写代码，烦请各位帮忙！
不知道表达清楚了没有，现上传模拟件，希望大家帮我解决，再次感谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-17 13:11

Sub Macro1()
Dim wb As Workbook, mypath$, wj$, s&
mypath = ThisWorkbook.Path & ""
Application.ScreenUpdating = False
wj = Dir(mypath & "*.xls")
Do While wj <> ""
If wj <> ThisWorkbook.Name Then
s = s + 1
Cells(2, s) = wj
Set wb = GetObject(mypath & wj)
With wb.Sheets("3")
.Range("q10:q" & .Range("q29").End(xlUp).Row).Copy Cells(3, s)
End With
wb.Close 0
End If
wj = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

跳转到最佳答案楼层

dsmch · 发表于 2014-4-17 13:11

Sub Macro1()
Dim wb As Workbook, mypath$, wj$, s&
mypath = ThisWorkbook.Path & ""
Application.ScreenUpdating = False
wj = Dir(mypath & "*.xls")
Do While wj <> ""
If wj <> ThisWorkbook.Name Then
s = s + 1
Cells(2, s) = wj
Set wb = GetObject(mypath & wj)
With wb.Sheets("3")
.Range("q10:q" & .Range("q29").End(xlUp).Row).Copy Cells(3, s)
End With
wb.Close 0
End If
wj = Dir
Loop
Application.ScreenUpdating = True
End Sub

复制代码

dsmch · 发表于 2014-4-17 13:13

打印每个工作簿表3第一页

wrzy012345 · 发表于 2014-4-17 13:39

dsmch 发表于 2014-4-17 13:13
打印每个工作簿表3第一页

貌似是可行的，我再仔细看看，先谢过了

wrzy012345 · 发表于 2014-4-17 13:42

dsmch 发表于 2014-4-17 13:13
打印每个工作簿表3第一页

仔细看了看，可以提取打印区域内的第1张表的Q列的值，我再看看能不能加上打印区域内的其它的页面，非常感谢你的帮助

wrzy012345 · 发表于 2014-4-17 14:14

dsmch 发表于 2014-4-17 13:11

.Range("q10:q" & .Range("q29").End(xlUp).Row).Copy Cells(3, s)这句能不能给我解释下，我换成这样为什么得出的结果不对呢？
.[q10].Resize([q29].End(xlUp).Row).Copy Cells(3, s)

wrzy012345 · 发表于 2014-4-17 14:23

dsmch 发表于 2014-4-17 13:11

希望不要嫌弃我，我还想再问个问题，为什么我把提取范围改为几段之后，汇总表不能按几段的值汇总？汇总的时候它自动就汇总了最大区间的数值呢？
.Range("q10:q" & .Range("q29").End(xlUp).Row).Copy Cells(3, s)
.Range("q41:q" & .Range("q60").End(xlUp).Row).Copy Cells(3, s)
.Range("q72:q" & .Range("q91").End(xlUp).Row).Copy Cells(3, s)

我把提取范围分开后，提取的值都是q72:q91的值了，汇总表它不能按(Q10：Q29，Q41：Q60，Q72：Q91)的顺序依次将值提取到相应的行内了呢？

wrzy012345 · 发表于 2014-4-17 14:44

dsmch 发表于 2014-4-17 13:11

我看出问题在哪了，再次感谢！

过江龙 · 发表于 2014-4-18 08:44

这个代码可以直接取你想取的数，前提是你要提取数的工作薄中的表已经全部设置了打印区域。

Sub JL()

Dim Arr, ArrJG()
Dim PathName$, dirna

Application.ScreenUpdating = False
column1 = Range("IV2").End(xlToLeft).Column
Range(Range("A2"), Cells(65536, column1)).ClearContents
   K = 1
PathName = ThisWorkbook.Path & "\*.xls"
dirna = Dir(PathName)
Do While dirna <> ""
      If dirna <> ActiveWorkbook.Name Then
         Set App = Application
         Set SourceBook = App.Workbooks.Open(ThisWorkbook.Path & "\" & dirna, 0, True)
         Set Sourcesheet = SourceBook.Worksheets("3")
         h = Split(dirna, ".")(0)
         j = 0
         With Sourcesheet
            Arr = .Range("Q10:Q" & Split(.PageSetup.PrintArea, "$")(4))
         End With
         SourceBook.Close False
         For i = 1 To UBound(Arr)
            If Arr(i, 1) <> "" Then
                  j = j + 1
                  ReDim Preserve ArrJG(1 To j)
                  ArrJG(j) = Arr(i, 1)
            End If
         Next i
            Cells(2, K) = h
            Cells(3, K).Resize(j) = Application.Transpose(ArrJG)
            K = K + 1
            Erase Arr
         End If
      dirna = Dir
Loop

Application.ScreenUpdating = True

End Sub

wrzy012345 · 发表于 2014-4-18 10:03

过江龙发表于 2014-4-18 08:44
这个代码可以直接取你想取的数，前提是你要提取数的工作薄中的表已经全部设置了打印区域。

Sub JL()

谢谢你的帮忙

		自动登录	找回密码
密码			注册

[已解决]如何批量提取工作薄中某个工作表中的固定行的不连续数据

相关帖子