导出文本文件到相应的文件夹内

qlmgu

请教和求助各位老师：如何根据评价人名导出评语为文本文件，并放入形成的文件夹内。由于评价信息比较多，一般有4000至数万，手工建立文件夹很难操作，所以希望把导出文本和建立文件夹两个功能合并。更新一下附件和输出文件名，希望导出的文件也有序号在前面。再次感谢各位老师。

示意图：




附件更新 导出文本文件到相应的文件夹内更新.rar (11.22 KB, 下载次数: 17)

2021-5-7 08:47 上传

点击文件名下载附件

山菊花

供参考。

qlmgu

山菊花 发表于 2021-5-7 08:58
供参考。

感谢山菊花大师出手相助，程序运行很快，很准确。我很抱歉，漏了说导出的文件也希望有原来的序号，见更新附件。如果可以麻烦老师，可以帮我把输出文件名加上序号吗？再次感谢您。

山菊花

楼上附件已按要求更新，请重新下载。

qlmgu

山菊花 发表于 2021-5-7 09:15
楼上附件已按要求更新，请重新下载。

再次感谢大师。

limonet

关键字：set-content replace

limonet

Sub limonet()
    Dim Brr As Variant, i%, k%, h$, Trr As Variant
    i = Range("A" & Rows.Count).End(xlUp).Row
    Brr = Application.Transpose(Range("B2:B" & i))
    For k = 1 To UBound(Brr)
        Name$ = Split(Brr(k), "评语")(0)
        Trr = Filter(Application.Transpose(Range("A2:A" & i)), Name, True)
        h = h & "';'" & Brr(k) & "'='" & Split(Trr(LBound(Trr)), Name)(0) & "-" & Trr(UBound(Trr))
    Next k
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";$h=@{" & Mid(h, 3) & "'};md ($h.values | select -unique);ForEach ($i in $h.Keys)" _
    & "{Set-Content ($h[$i]+'\'+($i -replace '(.*)(\d+)','$2$1$2.txt')) -Value $i}", 0
End Sub

limonet

Sub limonet()
    Dim Brr As Variant, i%, k%, h$, Trr As Variant
    i = Range("A" & Rows.Count).End(xlUp).Row
    Brr = Application.Transpose(Range("B2:B" & i))
    For k = 1 To UBound(Brr)
        Name$ = Split(Brr(k), "评语")(0)
        Trr = Filter(Application.Transpose(Range("A2:A" & i)), Name, True)
        h = h & "';'" & Brr(k) & "'='" & Split(Trr(LBound(Trr)), Name)(0) & "-" & Trr(UBound(Trr))
    Next k
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";$h=[ordered]@{" & Mid(h, 3) & "'};md ($h.values | select -unique);ForEach ($i in $h.Keys)" _
    & "{Set-Content ($h[$i]+'\'+(++$j,$i,'.txt' -join '')) -Value $i}", 0
End Sub

qlmgu

limonet 发表于 2024-6-17 11:46
关键字：set-content replace

感谢老师帮助。最近没上论坛，今天才看到。谢谢您。