博览网文 / excel / Excel|VBA不打开的情况下获取其它工作簿中...

分享

   

Excel|VBA不打开的情况下获取其它工作簿中的值,指定文件夹下工作簿名字模糊搜索定位|文件夹

2016-08-18  博览网文
  • Sub 提数_芐雨()
  •     Dim MyPath As String, Temp As String
  •     Dim arr, brr
  •     Dim wb As Workbook, twb As Workbook
  •     Dim sht As Worksheet, sh As Worksheet
  •     On Error Resume Next  '防错,打开无目标的工作表
  •     arr = Range("A2:C" & Cells(Rows.Count, 1).End(3).Row)
  •     MyPath = ThisWorkbook.Path & "\Aktuell"  '当前文件夹的路径
  •     ReDim brr(1 To UBound(arr), 1 To 1)
  •     For i = 1 To UBound(arr)
  •         fs = Dir(MyPath & "\*.xls") '查找文件名
  •         Do While fs <> ""
  •             If InStr(1, fs, arr(i, 1)) > 0 Then   '与文件名相符时执行
  •                 Set wb = GetObject(MyPath & "\" & fs)   '打开文件
  •                 Lrow = wb.Sheets(arr(i, 2)).Cells(Rows.Count, 1).End(3).Row '最大行号
  •                 With wb.Sheets(arr(i, 2)).Range("a1:a" & Lrow)
  •                     Set C = .Find(arr(i, 3), LookIn:=xlValues) '查找第一列的内容
  •                     If Not C Is Nothing Then   '非空时执行
  •                         brr(i, 1) = C.Offset(0, 4) '右偏移第四个单元格
  •                     End If
  •                 End With
  •                 wb.Close
  •             End If
  •             fs = Dir
  •         Loop
  •     Next
  •     Range("D2").Resize(UBound(arr), 1) = brr
  •     MsgBox "完成"
  • End Sub
    • 本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。

      0条评论

      发表

      请遵守用户 评论公约

      类似文章
      喜欢该文的人也喜欢 更多

      ×
      ×

      ¥.00

      微信或支付宝扫码支付:

      开通即同意《个图VIP服务协议》

      全部>>