返回列表 回复 发帖

[求助] 如何用程序实现从多个excel表中取出指定数据?

[求助] 如何用程序实现从多个excel表中取出指定数据?

请教:能否用程序实现自动从多个excel表中(每个表的活动工作表名称相同)找出金额大于或等于10万元一行,并将这一行复制到新表中。本例中是从多个test表中查找然后复制形成一个新的答案表。
谢谢!
附件: 您需要登录才可以下载或查看附件。没有帐号?注册
请试一试,

Sub test()
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Mother = ActiveWorkbook.Name
        
a:
    i = MsgBox("do you want to open a new file?", vbYesNo)
        
      If i = vbYes Then
        lcFilter = "*.*"
        lcPrompt = "Select Source File"
        lcLookup = "File (" + lcFilter + "), " + lcFilter
        LcFilename = Application.GetOpenFilename(lcLookup, , lcPrompt)
   
        If LcFilename <> "False" Then
            Workbooks.Open Filename:=LcFilename
                Source = ActiveWorkbook.Name
                    ScourSheet = ActiveSheet.Name
        Else:
            End
        End If
              
        Row = 3
            Do
                Row = Row + 1
                If Cells(Row, 3) >= 100000 Then
                    Rows(Row).Copy
                    Workbooks(Mother).Activate
                        Rows(Range("A65536").End(xlUp).Row + 1).Select
                        ActiveSheet.Paste
               
                End If
                Workbooks(Source).Activate
            Loop Until Cells((Row + 1), 3) = ""
            Workbooks(Source).Close (False)
        GoTo a:
        
      End If


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub
谢谢。             
如果标题行是合并单元格,要求提取最后一列中金额>=10万元的,其他条件不变,能实现吗?请指教!

[ 本帖最后由 rg555555 于 2006-5-16 07:35 编辑 ]
附件: 您需要登录才可以下载或查看附件。没有帐号?注册
一样可以的,你就着我的程序去改就可以了,需要改动的是
    If Cells(Row, 7) >= 100000 Then

   Loop Until Cells((Row + 1), 7) = ""

相信这样就可以了。
不错,但有一点,就是当第一行或后面某行的需统计的数据单元格为0,而第二行或为空的格后的单元格数据大于10万元时,就取不到这一行数据了。
高手们,请帮忙。
                      
返回列表