[已解决]求助：如何在多个工作簿中按条件提取？？

没想到呢 · 发表于 2010-4-10 11:39

最近要处理一批文件，都是重复劳动~~ 麻烦哪位出手帮助！！感谢~~

主要如下：
文件“LIST" ，需要：匹配list的”name“列，在文件夹里所有excel 文件中查找相同name code 行，并将相应的address 填入list中的 address单元格，把此文件名填入list相应行。
不晓得，表达的，给为能不能看懂~~

帮忙帮忙看看，能不能批量解决？？？我有几千行数据要找~~极度郁闷中。。。

QUF14lE0.rar (4.85 KB, 下载次数: 10)

过江龙 · 发表于 2010-4-10 11:50

帮你顶一顶，期待高手来解决。

没想到呢 · 发表于 2010-4-10 11:52

感谢，感谢~~期待高人！！

或者，有什么可以借鉴的嘛？？我自己琢磨琢磨。。。

没想到呢 · 发表于 2010-4-10 16:06

自己顶一下~

开辆小富康 · 发表于 2010-4-10 17:03

Sub GetName()
     Dim F$
     Dim Arr
     Dim Arr2()
     If MsgBox("运行程序前请保存关闭需要导入的EXCEL文件，准备好了吗？", vbYesNo) = vbNo Then Exit Sub
     Application.DisplayAlerts = 0
     Application.ScreenUpdating = 0
     F = Dir(ThisWorkbook.Path & "/" & "*.xls")
     Do
      If F <> ThisWorkbook.Name Then
       Workbooks.Open ThisWorkbook.Path & "\" & F
       With ActiveWorkbook.Sheets("Sheet1")
        r = .Range("D65536").End(xlUp).Row
        If r > 1 Then
         Arr = .Range("D2:J" & r)
         ReDim Arr2(1 To UBound(Arr), 1 To 4)
         For i = 1 To UBound(Arr)
          Arr2(i, 1) = Arr(i, 1): Arr2(i, 2) = Arr(i, 2)
          Arr2(i, 3) = Arr(i, 7): Arr2(i, 4) = F
         Next i
         With ThisWorkbook
          .Sheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0).Resize(UBound(Arr2), 4) = Arr2
         End With
        End If
       End With
       ActiveWorkbook.Close False
      End If
      F = Dir()
     Loop While F <> ""
    Application.ScreenUpdating = 1
    Application.DisplayAlerts = 1
End Sub

EKOGDF41.rar (12.35 KB, 下载次数: 33)

没想到呢 · 发表于 2010-4-10 17:21

QUOTE:

以下是引用开辆小富康在2010-4-10 17:03:00的发言：
Sub GetName()
     Dim F$
     Dim Arr
     Dim Arr2()
     If MsgBox("运行程序前请保存关闭需要导入的EXCEL文件，准备好了吗？", vbYesNo) = vbNo Then Exit Sub
     Application.DisplayAlerts = 0
     Application.ScreenUpdating = 0
     F = Dir(ThisWorkbook.Path & "/" & "*.xls")
     Do
      If F <> ThisWorkbook.Name Then
       Workbooks.Open ThisWorkbook.Path & "\" & F
       With ActiveWorkbook.Sheets("Sheet1")
        r = .Range("D65536").End(xlUp).Row
        If r > 1 Then
         Arr = .Range("D2:J" & r)
         ReDim Arr2(1 To UBound(Arr), 1 To 4)
         For i = 1 To UBound(Arr)
          Arr2(i, 1) = Arr(i, 1): Arr2(i, 2) = Arr(i, 2)
          Arr2(i, 3) = Arr(i, 7): Arr2(i, 4) = F
         Next i
         With ThisWorkbook
          .Sheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0).Resize(UBound(Arr2), 4) = Arr2
         End With
        End If
       End With
       ActiveWorkbook.Close False
      End If
      F = Dir()
     Loop While F <> ""
    Application.ScreenUpdating = 1
    Application.DisplayAlerts = 1
End Sub

是这个意思吗？请解压文件夹以后运行。所有文件放在同一个文件夹下面。

QUOTE:

麻烦，怎么用，导入后跳出个框，点击是后么反应~~

开辆小富康 · 发表于 2010-4-10 18:39

请解压文件夹以后运行。所有文件放在同一个文件夹下面。

溦兰 · 发表于 2010-4-10 19:21

试着弄了一个,你看是要这样的效果不 oz27zKbJ.rar (19.15 KB, 下载次数: 73)

没想到呢 · 发表于 2010-4-10 20:29

QUOTE:

以下是引用溦兰在2010-4-10 19:21:00的发言：

试着弄了一个,你看是要这样的效果不

版版！！下标越界~~ 怎么弄弄？？在线等。。。感谢哈

没想到呢 · 发表于 2010-4-10 20:34

QUOTE:

以下是引用开辆小富康在2010-4-10 18:39:00的发言：
请解压文件夹以后运行。所有文件放在同一个文件夹下面。

麻烦，大侠！！

list里的内容是固定的，就是说，list里的name 和code是不能删的~~

你给我弄的那个新的list里，好像name code里都空的，起到了个导入功能，我想要的是，

在文件夹中，当name符合是，查找code符合的行，填写address和文件名称到list的相应列中。

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

[已解决]求助：如何在多个工作簿中按条件提取？？

求高人出手做个宏！多文件中批量查找填写~~

求高人出手做个宏！多文件中批量查找填写~~

求高人出手做个宏！多文件中批量查找填写~~