Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1990|回复: 9

[已解决]求用VBA提取文件夹下的excel表里面其中的一列

[复制链接]
发表于 2017-7-16 10:03 | 显示全部楼层 |阅读模式
求用VBA提取文件夹下的excel表里面其中的含有 ip 一列,只要提取IP那一列就行了,麻烦高手下载附件看看,小弟跪谢了。
最佳答案
2017-7-16 16:40
  1. Sub tt()
  2. Dim arr, i%, y%, Mypath$, Wb$
  3. Application.ScreenUpdating = False
  4. Mypath = ThisWorkbook.Path & ""
  5. If Dir(Mypath & "IP新文件夹", vbDirectory) = "" Then MkDir Mypath & "IP新文件夹"
  6. Wb = Dir(Mypath & "*.xls*")
  7. Do While Wb <> ""
  8.     If InStr(Wb, ThisWorkbook.Name) = 0 Then
  9.         Workbooks.Open Mypath & Wb
  10.         arr = Sheet1.UsedRange
  11.         ActiveWorkbook.Close False
  12.     Else
  13.         arr = Sheet1.UsedRange
  14.     End If
  15.    
  16.     For i = 1 To UBound(arr)
  17.         For y = 1 To UBound(arr, 2)
  18.             If arr(i, y) = "IP" Then
  19.                 Workbooks.Add
  20.                 With ActiveWorkbook
  21.                    .Sheets(1).Range("a1").Resize(UBound(arr)) = Application.Index(arr, , y)
  22.                     .SaveAs Mypath & "IP新文件夹" & Format(Now(), "hhmmss") & Wb
  23.                     .Close True
  24.                 End With
  25.                 GoTo 100
  26.             End If
  27.     Next y, i
  28. 100:
  29.     Wb = Dir
  30. Loop
  31. Application.ScreenUpdating = True
  32. End Sub
复制代码

提取文件夹的表以IP那一列.rar

14.39 KB, 下载次数: 11

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-7-16 11:33 | 显示全部楼层
回复

使用道具 举报

发表于 2017-7-16 11:43 | 显示全部楼层
  1. Sub tt()
  2.     Dim arr, i%, y%
  3.     arr = Sheet1.UsedRange
  4.     For i = 1 To UBound(arr)
  5.         For y = 1 To UBound(arr, 2)
  6.             If arr(i, y) = "IP" Then
  7.                 Worksheets.Add after:=Worksheets(Worksheets.Count)
  8.                 Range("a1").Resize(UBound(arr)) = Application.Index(arr, , y)
  9.                 Exit Sub
  10.             End If
  11. Next y, i
  12. End Sub
  13. '试试这个代码
复制代码
回复

使用道具 举报

 楼主| 发表于 2017-7-16 11:58 | 显示全部楼层

好的,谢谢,我试试
回复

使用道具 举报

 楼主| 发表于 2017-7-16 14:24 | 显示全部楼层
苏子龙 发表于 2017-7-16 11:33
提取到哪里,要什么效果?

可能帮忙,你在新建一个表,直接提取IP那一列,注意一下,IP是不固定的,下载可能放B列,可能放在C列,然后生成到新表的A列吗?
回复

使用道具 举报

发表于 2017-7-16 14:26 | 显示全部楼层
qg5041 发表于 2017-7-16 14:24
可能帮忙,你在新建一个表,直接提取IP那一列,注意一下,IP是不固定的,下载可能放B列,可能放在C列,然 ...

上面代码,基本上就是这样的!
回复

使用道具 举报

 楼主| 发表于 2017-7-16 14:34 | 显示全部楼层
苏子龙 发表于 2017-7-16 14:26
上面代码,基本上就是这样的!

就是文件夹新建一个excel表,提取【提取的表以IP那一列.xls】这个表里面的IP那一列,放到新建一个excel表的A列

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0

End Sub好像要加入这些代码
回复

使用道具 举报

 楼主| 发表于 2017-7-16 14:37 | 显示全部楼层
qg5041 发表于 2017-7-16 14:34
就是文件夹新建一个excel表,提取【提取的表以IP那一列.xls】这个表里面的IP那一列,放到新建一个excel表的 ...

麻烦您了。不知道我表达的方式是不是不够清楚
回复

使用道具 举报

发表于 2017-7-16 16:40 | 显示全部楼层    本楼为最佳答案   
  1. Sub tt()
  2. Dim arr, i%, y%, Mypath$, Wb$
  3. Application.ScreenUpdating = False
  4. Mypath = ThisWorkbook.Path & ""
  5. If Dir(Mypath & "IP新文件夹", vbDirectory) = "" Then MkDir Mypath & "IP新文件夹"
  6. Wb = Dir(Mypath & "*.xls*")
  7. Do While Wb <> ""
  8.     If InStr(Wb, ThisWorkbook.Name) = 0 Then
  9.         Workbooks.Open Mypath & Wb
  10.         arr = Sheet1.UsedRange
  11.         ActiveWorkbook.Close False
  12.     Else
  13.         arr = Sheet1.UsedRange
  14.     End If
  15.    
  16.     For i = 1 To UBound(arr)
  17.         For y = 1 To UBound(arr, 2)
  18.             If arr(i, y) = "IP" Then
  19.                 Workbooks.Add
  20.                 With ActiveWorkbook
  21.                    .Sheets(1).Range("a1").Resize(UBound(arr)) = Application.Index(arr, , y)
  22.                     .SaveAs Mypath & "IP新文件夹" & Format(Now(), "hhmmss") & Wb
  23.                     .Close True
  24.                 End With
  25.                 GoTo 100
  26.             End If
  27.     Next y, i
  28. 100:
  29.     Wb = Dir
  30. Loop
  31. Application.ScreenUpdating = True
  32. End Sub
复制代码

提取文件夹的表以IP那一列.zip

30.34 KB, 下载次数: 13

回复

使用道具 举报

 楼主| 发表于 2017-7-17 09:54 | 显示全部楼层

谢谢大神,帮忙解答了。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 21:17 , Processed in 0.334568 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表