作者：绿色风
分类：
时间：2022-08-17
浏览：101
楼主
0Mouse |
Q：如何运用VBA求得多个路径下同名文本文件所含三位数字串的交集呢？
示例截图1：
示例截图2：
示例截图3：
示例截图4：
要求描述：
如示例截图所示，三个文件路径依次放在B2:D2单元格中，路径单元格下方依次是所含各文本文件的名称。
每个文本文件内含有由0-9这十个数字所构成的三位数字串，格式示例如下：
058
129
330
455
642
……
现在，希望求得各路径下相同名称的文本文件所含三位数字串的交集，并将结果放置在F2单元格所示路径下，名称与计算交集时采用的文本文件名称相同，并在G列相应单元格显示交集结果中所含三位数字串的个数。
A：代码如下：- Sub 求得多个路径下同名文本文件所含三位数字串的交集()
- Application.ScreenUpdating = False
- Dim arr, fs As Object, i As Byte, j As Byte, f$, fd As Object, brr(1 To 3), crr, k%, sr$, m%, ff$
- arr = [B2:D9]
- Set fs = CreateObject("scripting.filesystemobject")
- For i = 2 To UBound(arr)
- For j = 1 To 3
- f = arr(1, j) & "\" & arr(i, j) & ".txt"
- Set fd = fs.opentextfile(f)
- brr(j) = fd.readall
- fd.Close
- Next
- crr = Split(brr(1), Chr(13))
- For k = 0 To UBound(crr)
- If InStr(1, brr(2), crr(k)) > 0 And InStr(1, brr(3), crr(k)) > 0 Then
- m = m + 1
- sr = sr & Chr(13) & crr(k)
- End If
- Next
- Cells(i + 1, "G") = m
- ff = Range("F2").Text & "\" & Cells(i + 1, "F") & ".txt"
- Open ff For Output As #1
- Print #1, Mid(sr, 2)
- Close
- f = "": m = 0: sr = ""
- Set fd = Nothing
- Erase crr: Erase brr
- Next
- Erase arr
- Application.ScreenUpdating = True
- End Sub
附件：
 数据处理.rar
|
2楼
い卋玑┾宝珼 |
学习了
 |
3楼
老糊涂 |
学习了 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一