如何实现文本文件分组提取

msw2395 · 发表于 2024-4-19 11:08

本帖最后由 msw2395 于 2024-4-19 20:59 编辑

如图表所示，A2-A31有30个文本序号，按相邻4个为一组进行分组，共有27组；将每组序号的4个文本从文本总目录中复制出来并存放在指定文件夹下。比如分组序号01的4个文本00134.txt、00366.txt、00325.txt、00103.txt存放在D:\新建文件夹\01\中，其它的按同样方法存放在对应文件夹下。

麻烦老师们看下如何实现，谢谢！！

baofa2 · 发表于 2024-4-19 11:37

Sub test0()
  Dim ar, i As Long, j As Long, k As Long
  Dim src As String, dst As String, fld As String
  src = ThisWorkbook.Path & "\文本总目录\"
  dst = "D:\新建文件夹\"
  ar = Range("A1").CurrentRegion.Columns(1)
  With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(dst) Then .CreateFolder dst
For i = 2 To UBound(ar) - 3
   k = k + 1
   fld = dst & Format(k, "00") & "\"
   If Not .FolderExists(fld) Then .CreateFolder fld
   For j = i To i + 3
      If .FileExists(src & ar(j, 1) & ".txt") Then
      .CopyFile src & ar(j, 1) & ".txt", fld & ar(j, 1) & ".txt", True
      End If
   Next
Next
  End With
  Beep
End Sub

baofa2 · 发表于 2024-4-19 11:55

擦还没审核通过.zip (172.93 KB, 下载次数: 7)

铁马1980 · 发表于 2024-4-19 12:56

参与一下

文本序号分组.zip (17.72 KB, 下载次数: 6)

msw2395 · 发表于 2024-4-19 15:46

铁马1980 发表于 2024-4-19 12:56
参与一下

谢谢铁马1980老师解答！！但有个问题，只有01-15文件夹中有数据，16-27文件夹没有数据，不知为何?

limonet · 发表于 2024-4-21 21:00

关键字：Powershell copy-item，批量移动。

limonet · 发表于 2024-4-21 21:04

Sub limonet()
Dim Arr As Variant, i%, j%, S$, Path$
Path = ThisWorkbook.Path & "\Limonet\"
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.CurrentDirectory = ThisWorkbook.Path & "\文本总目录"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 4
      j = j + 1
      S = Join(Application.Transpose(Range(Cells(i, "A"), Cells(i + 3, "A"))), ".txt,") & ".txt"
      MkDir Path & Format(j, "00")
      WSHShell.Run "Powershell copy-item " & S & " " & Path & Format(j, "00"), 0, True
Next i
End Sub

铁马1980 · 发表于 2024-4-23 09:00

msw2395 发表于 2024-4-19 15:46
谢谢铁马1980老师解答！！但有个问题，只有01-15文件夹中有数据，16-27文件夹没有数据，不知为何?

数组下标搞错了

文本序号分组.zip (16.61 KB, 下载次数: 4)

		自动登录	找回密码
密码			免费注册

[已解决] 如何实现文本文件分组提取

评分

评分

评分

评分