请教EXCEL VBA中的一个问题
本回答由提问者推荐
var sogou_ad_id=731547;
var sogou_ad_height=160;
var sogou_ad_width=690;查看: 706|回复: 1
请教VBA递归上的一个小问题
阅读权限20
在线时间 小时
下面是网上的一段关于递归的一段子程序,
想请教一个小问题,
程序中SearchFiles(ByVal fd As Folder),是不是只能运行fd?&&为什么又能运行sfd呢?
Set fd = fso.GetFolder(strPath) '设置fd文件夹对象
SearchFiles fd '调用子程序查搜索文件
Sheets(1).Range(&A1&).Resize(cntFiles) = Application.Transpose(ArrFiles) '把数组内的路径和文件名放在单元格中
****************************************
Sub SearchFiles(ByVal fd As Folder)
Dim fl As File
Dim sfd As Folder
For Each fl In fd.Files '通过循环把文件逐个放在数组内
cntFiles = cntFiles + 1
ArrFiles(cntFiles) = fl.Path
If fd.SubFolders.Count = 0 Then Exit Sub 'SubFolders返回由指定文件夹中所有子文件夹（包括隐藏文件夹和系统文件夹）组成的 Folders 集合
For Each sfd In fd.SubFolders '在 Folders 集合进行循环查找
SearchFiles sfd '使用递归方法查找下一个文件夹
阅读权限95
在线时间 小时
两个程序间的fd不是同一个fd
阅读权限20
在线时间 小时
本帖最后由 zhulx_wx 于
14:37 编辑
两个程序间的fd不是同一个fd
谢谢回复!已经试通了!
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师VBA问题，请问如何查找某个数据所在的位置【excel吧】_百度贴吧
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&签到排名：今日本吧第个签到，本吧因你更精彩，明天继续来努力！
本吧签到人数：0成为超级会员，使用一键签到本月漏签0次！成为超级会员，赠送8张补签卡连续签到：天&&累计签到：天超级会员单次开通12个月以上，赠送连续签到卡3张
关注：167,822贴子：
VBA问题，请问如何查找某个数据所在的位置收藏
在激活工作簿下，比如整个工作簿只有唯一的一个“全世界”,且在A1中我想在整个激活工作簿下查找&全世界&，并返回所在的位置
A1用VBA怎么做？谢谢
直接查找全世界，勾选工作簿即可。Sub test()Dim sh As WorksheetFor Each sh In Worksheets
If sh.Cells(1, 1) = &全世界& Then sh.Activate: Exit Sub NextEnd Sub
sub hh()dim cell as rangedim i%for i=1 to worksheets.countfor each cell worksheets(i).usedrangeif cell.value=&全世界& thenmsgbox &位置为表格& & worksheets(i).name &的& & cells.addressexit subend ifnextnextmsgbox &未找到数据!&end sub
Sub test()Dim sh As Worksheet, rg As RangeFor Each sh In Worksheets
For Each rg In sh.UsedRange
If rg.Value = &全世界& Then
sh.Activate
Next NextEnd Sub
vba只提供了一个方法find，和查找功能相对等来查找值其余方法都是循环单元格的值
Sub test2()Dim rng As RangeDim i As IntegerDim str As String '待查值str = InputBox(&请输入要查找的值&)If str = && Then
Exit SubEnd IfFor i = 1 To Worksheets.Count
For Each rng In Worksheets(i).UsedRange
If rng.Value = str Then
MsgBox &位置为表格& & Worksheets(i).Name & &的& & rng.Address
Worksheets(i).Select
Range(rng.Address).Select
NextNextMsgBox &未找到数据!&End Sub
登录百度帐号在Excel中使用VBA来筛选数据
&?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /&
1.问题由来
早晨还没有完全醒来，你就被电话吵醒，有一个中学同学向你请教一个Excel的问题。作为一个所谓的Excel专家，你经常会受到此类骚扰。问题大概是这样的，一个很大的Excel文件，其中有些行是重复的，也就是说，有2行是完全一样的，而有些行是不重复的，现在的问题是要找出所有不重复或者重复的行，你没有听明白。你大概考虑了一下，用“VLOOKUP”查找一下，然后重新排序，应该就可以了，你需要试一下，然后告诉他怎么用，于是你告诉他，20分钟后再打电话给你。
2.问题解决的思路
你首先打开Excel，输入一些测试数据，大概是这个样子：
&?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /&
其中“张三”、“李四”有2个，其他只有一个，需要把他们分出来。首先在B列输入1，然后向下填充，在C列输入“VLOOKUP(A1,$A$1:$B$7,2,FALSE)”，如果找到，那么返回1，如果找不到，空着就可以了。结果C列全部变成了1 ，因为查找自己肯定可以找到，那么查找的Range必须要去除本行。
你接着找了几个其他函数，“MATCH”，“INDEX”试了试，都无法办到；那么用IF函数呢，你开始试着写IF函数。先输入第4行吧，参数和引用区域回头再处理，或许Excel聪明到可以填充出你需要的引用区域。
你输入了如下的IF函数：
IF(OR(VLOOKUP(A4,A1:B3,2,FALSE),VLOOKUP(A4,A5:B7,2,FALSE)),1,0)
真够复杂的，Excel应该开一个小窗口，然后作为代码输入这样的判断逻辑，IF函数可以嵌套7层，真不知道微软的工程师怎么想的，你一边嘟囔一边按下了回车，结果是“#N/A”，就是“值不可用”，你知道函数 VLOOKUP如果找不到需要的值，则返回错误值 #N/A，表达式里有了这个东东，所以不管什么计算，结果都是它了。
从工具菜单选择“错误检查”，“显示计算步骤”，证实了你的猜测，第二个VLOOKUP函数返回的错误值 #N/A传递到了最后。
这时，你同学的电话来了，你告诉他需要写一段小程序，你决定还是使用直接又简单的VBA来解决问题。
打开VBA编辑器，插入一个模块，你不假思索的敲入了以下代码：
Sub SelectDouble()
Dim i As Long, j As Long
For i = 1 To 7 Step 1
For j = 1 To 7 Step 1
'不比较相同的行
If i && j Then
If Range("A" & i).Value = Range("A" & j).Value Then
Range("E" & i).Value = 1
点击运行，很好，是重复的都标志了1，没有重复的空着，然后排序就可以了。你很满意你还输入了一行注释。你拨通了你同学的电话，告诉他可以了，然后他打电话给你，你把程序念给他，告诉他该改什么地方。天知道他上学时学的什么语言，反正不是Basic，你得解释Dim是什么含义。经过一番折腾，他终于在电话另一端把代码输入了计算机。作为电信员工的他可以每天24小时用电话聊天，只是可怜你的手机话费单，你叹了口气，该去洗脸刷牙了。
洗完脸，刷完牙，你泡好了一杯咖啡，又回到了计算机旁边，电话又来了。你以为是告诉你已经完成了的“喜讯”，听到的却是说死机了，愣了0.1秒钟，你想想应该是程序还在执行或者是死循环。你问了他大概的数据量，知道大概有9000多条记录，还好，你想。
你检查了一下代码，没有什么死循环，也许是你同学输入时有什么错误，你把循环改到1到10000，然后拿起杯子，咽了一口咖啡，往后靠了靠，等着计算结果。几分钟过去了，还是没有结束，你觉得有些奇怪，你敲了“Ctrl + Break”，暂停了程序，将鼠标放在i变量上，显示i还是24，TNND，你知道是Range函数太慢，算了，你打电话告诉你同学，大概需要几个小时才可以计算完成。你又喝了一口咖啡，自言自语道，比起手工筛选，毕竟很快了。
但不就不到1万条纪录吗，Excel的VLOOKUP等内置函数一眨眼也就计算好了啊。
4.1.通过数组
数组要比Range函数快一些，你把程序改了一下，定义了2个数组，首先把数据全部读入第一个数组，然后对数组进行操作，对于重复的，把第二个数组的相应部分写为1，计算完成后，根据第二个数组，把结果写回去。程序代码如下：
Sub SelectDouble2()
Dim i As Long, j As Long
Dim max As Long
Dim a() As String, b() As Long
max = 10000
ReDim a(max) As String
ReDim b(max) As Long
For i = 1 To max Step 1
a(i) = Range("A" & i).Value
For i = 1 To max Step 1
For j = 1 To max Step 1
'不比较相同的行
If i && j Then
If a(i) = a(j) Then
For i = 1 To max Step 1
Range("F" & i).Value = b(i)
你执行了一下，对于10000条纪录，大概需要不到5分钟。你觉得很满意，效率提高了几个数量级，你还没有忘记设置了一个max变量，这样，代码使用时改动就会少很多。
4.2.使用内置函数
你又想起了VLOOKUP这个函数，真是阴魂不散。是啊，为什么VLOOKUP执行这么快，当然是因为它是编译好的，不是用VBA写的。你灵机一动，为什么不用这个函数呢，在VBA中，可以使用Application.函数名，调用Excel的内置函数。这样，改过的代码如下：
Sub SelectDouble3()
Dim i As Long, j As Long, a, b
For i = 2 To 9999 Step 1
a = Application.VLookup(Range("A" & i), Range("A1:B" & (i - 1)), 2, False)
b = Application.VLookup(Range("A" & i), Range("A" & (i + 1) & ":B1000"), 2, False)
If IsError(a) And IsError(b) Then
Range("G" & i).Value = 0
代码很短，但有一点复杂和讨厌，循环是从2到9999，因为为了防止VLOOKUP函数的Range范围失效，所以这两行需要手动处理。IsError函数来检测返回值，如果两个返回值都是错误，则此行为单一的没有重复的行，标志为0即可。程序执行速度和上面的差不多，至少你没有感觉出来差别。
4.3.继续Hack
到这里，你还是觉得不满意，使用数组，数据量太大会内存吃紧，使用VLOOKUP函数，代码觉得很丑陋。你不知道为什么想起来二分查找之类的东东，那么，查找前应该先排序，你在Excel里把数据排了序。现在的问题是需要循环2次，复杂度为N*N，如果…...，你想如果排好了序，只需要检查当前数值和下一个是否一样，如果一样，那么把当前和下一个位置标示出来，循环变量加2，跳过下一个，如果不一样，循环变量加1继续比较就可以了，代码如下：
Sub SelectDouble4()
Dim i As Long, Max As Long
Max = 10000
If Range("A" & i).Value = Range("A" & (i + 1)).Value Then
Range("I" & i).Value = 1
Range("I" & (i + 1)).Value = 1
&?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" /&Loop While i & Max
这个程序复杂度只有N，执行速度当然是你今天写的所有程序里最快的，而且内存占用也最小。你觉得很满意，露出了贼贼的笑容。
你打开了日志，开始记下了今天问题的解决过程。
你想，嗯，如果只是想怎样把Range函数变快来解决问题，速度不会有本质的提高。速度提高，第一，排序才是关键，快速的查找和搜索都是要基于排好序的内容，比如二分查找，那么，为什么数据库要建索引，索引的有无对于查找速度影响很大，道理都是一样的了；第二，查找时没有回溯，对于查找过的内容直接跳过，这个和字符串的匹配算法，好像是KMP算法，思路是一样的，嗯，那么如果不是相同的内容不是2个，是多个，那么你可以使用一个循环来前溯，并且，对于不同的个数，可以标识为不同的数字。你忽然觉得自信满满，似乎要忘了已经失业半年的事实。
在表格或数值数组的首列查找指定的数值，并由此返回表格或数组当前行中指定列处的数值。当比较值位于数据表首列时，可以使用函数 VLOOKUP 代替函数 HLOOKUP。具体用法可以参考Excel帮助。
没有更多推荐了，
加入CSDN，享受更精准的内容推荐，与500万程序员共同成长！查看: 2658|回复: 2
请教一个创建word的问题
阅读权限20
在线时间 小时
有一个EXCEL信息源里3个来宾（可能有很多），要根据来宾姓名生产一个word，名字为姓名，且 根据对应的性别 年龄等填入表中位置。。。求教怎么实现编程？
以下内容可以忽略：（
我能做到的就是利用filecopy 批量创建word； 但是填表的过程就是很笨的了，利用的是Word的黏贴连接功能。1 在EXCEL里创建一个动态的单个来宾信息区域 ，把这个动态区域的内容黏贴链接到word里，然后每次复制新的内容到EXCEL的动态区域里，再利用word的黏贴链接，最后在word里做了一个unlink。） 这样做每做一个来宾，就要复制一次来宾信息到动态区域里，其实还是没有实现自动化。故请教高手指点迷津，感激不尽！！！
(3.99 KB, 下载次数: 30)
23:44 上传
点击文件名下载附件
该贴已经同步到
阅读权限20
在线时间 小时
这个问题我也自己想出来了，如果有需要用到同样东西的朋友，供参考。。。
主要是解决一个问题。。。 通过EXCEL的表格，将许多信息批量输入到word里
步骤分三步& &1&&制作好一个能批量从excel 填数的doc模板，并且把它黏贴链接到 EXCEL
2&&制作一个动态的excel 源，讲其链接到需要填充的EXCEL的数据源中
3&&在word 中创建一个宏
sub n111&&'创建这个宏旨在，创建一个doc后，打开此doc先更新链接到excel动态源，再删除链接，即实现了excel的填表原理
dim link as field
for each link in avtivedocuments.fields
link.update
link.unlink
4 在EXCEL中书写宏&&以 数据源工作簿为 data，数据源工作表为 ds ，链接到word的动态源工作表为dt 为例
sub&&dele111& && && && &
dim i as integer ,doc1 as object ,n as integer ,pp as string,wokao as sting
workbooks(&data&).worksheets (&ds&).activate '激活数据源的表
n =application.worksheetfunction.conta(&a:a&) '&&求出有效数据源的行数，确定循环执行的次数
set doc1 as createobject（&word.application“） '打开word
doc1.visible = false '隐藏word
for i =2 to n
row(i).copy& & '复制数据源的数据
workbooks(&data&).worksheets (&dt&).activate '
pp = cells(i,2) .value&&'根据数据源的内容创建doc的名字
wokao = &D:\&&pp.&&.doc&&&' 放到d盘的文件名
filecopy d:\word模板.doc destination:=wokao '创建doc
range(&a1&).select
avtivesheet.paste&&‘黏贴数据到动态数据区域
doc1.documents.open(wokao)
doc1.run n111 '打开创建的doc并执行宏n111 更新并删除链接
由于是在公司根据具体案例写的，这里写的没有列具体案例，有需要再说，不过程序代码都在上面了。希望能够帮到那些，希望用excel批量创建word的朋友们
阅读权限30
在线时间 小时
●★将Excel数据写入Word模板★●
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师