|
- Sub Macro1()
- Dim arr, mypath$, wj$, d, zf$, i&
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1").CurrentRegion
- mypath = ThisWorkbook.Path & "\测试文件"
- wj = Dir(mypath & "*.txt")
- Do While wj <> ""
- zf = Split(Split(wj, ".txt")(0), "-")(0)
- d(zf) = d(zf) + 1
- wj = Dir
- Loop
- For i = 2 To UBound(arr)
- arr(i, 2) = d(arr(i, 1))
- Next
- Range("b1").Resize(UBound(arr)) = Application.Index(arr, 0, 2)
- End Sub
复制代码 |
|