文本写入模块与宏循环完美结合的求助

天地一相

感谢帮助！详见截图附件。附件里有2个宏，我想把这个模块1里的宏放在表1宏循环的c层，然后这个文本写入的宏这样工作：第1次运行，依据E1单元格给的文件名新建一个文本文件，然后开始写入每1次c层执行后表1符合条件的内容，累计按行写入，直到运行了600次，本次写入完成后，保存关闭文本。接着开始下一个600次的执行。此时，我E1单元格的文件名就会更换成新的1个。如此就需要修改附件模块1里的代码，请帮助修改一下。感谢

liulang0808

建议楼主结合附件内容，描述具体需求以及实现步骤

·遁去的一·

liulang0808 发表于 2023-6-5 08:13
建议楼主结合附件内容，描述具体需求以及实现步骤

版主看看我的贴子呗，https://club.excelhome.net/threa ... tml?_dsign=6b220770

天地一相

liulang0808 发表于 2023-6-5 08:13
建议楼主结合附件内容，描述具体需求以及实现步骤

谢谢，你让我看到了希望。在整理思路描述如下：我附件里有两个宏，表1里的是一个宏循环，模块里的是一个提取符合条件的内容并写入文本的宏，是本站网友帮写的。我的宏循环，有3层嵌套，最外层的a层每执行一个，我需要文本写入的宏完整执行一次。具体：宏循环b和c层是一个完整执行，两层相乘，c层的宏实际执行了600遍。也就是表1执行计算了600遍，每一遍会产生不同的结果，文本写入宏需要把这600次的结果按规则写入同一个文本文件。现在不知道如何结合这两个VBA。测试发现，若把文本写入宏放置在宏循环的c层里，是不能实现我想的操作的。这样说吧：我想把这个“文本写入”宏放在宏循环的c层，然后这个文本写入宏这样工作：第1次运行，依据E1单元格给的文件名新建一个文本文件，然后开始写入符合条件的内容，累计按行写入，直到运行了600次，本次写入完成后，保存关闭文本。接着开始下一个600次的执行。此时，我E1单元格的文件名就会更换新的1个。如此就需要修改附件模块1里的代码，请帮助修改一下。感谢

liulang0808

Sub 计算结果保存文本()                      '请修改下数据定义，测试发现行数多了结果就错了。
    Dim a As Long
    Static b As Integer
    Static c As Integer
    Dim tm
    Dim ar, br, i&, r&, strJoin
    Open ThisWorkbook.Path & "\ " & [E1].Value & ".txt" For Output As #1

   
   
    Application.ScreenUpdating = False
     
     For a = 1 To [H1]    '这里的最外层的循环，每一个执行都需要完成一次新建写入保存，循环C层实际执行了600次数据计算，这结果属于一个文本
   
       Calculate          'a层每执行一次，E1的文件名就会更换成新的。每一个完整的文本保存对象是完全涵盖b层循环的全部结果
      
       For b = 1 To 10
           
           Calculate
           
           For c = 1 To 60
              Calculate
                strJoin = ""
                r = 0
                ar = Range("H3", Cells(Rows.Count, "H").End(xlUp))
                br = [Q3].CurrentRegion
                For i = 1 To UBound(ar)
                    If ar(i, 1) = 4 Then
                        r = r + 1
                        ar(r, 1) = br(i, 1) & "-" & br(i, 2) & "-" & br(i, 3) & "-" & br(i, 4) & "-" & br(i, 5) & "-" & br(i, 6) & "-" & br(i, 7)
                        strJoin = strJoin & vbCrLf & ar(r, 1)
                    End If
                Next
                If strJoin <> "" Then
                   Print #1, Mid(strJoin, 3)
                End If
           Next c
      
       Next b
     
     Next a
   
    [J1] = Format(Now() - tm, "HH:mm:ss")
   
    Beep
    Application.ScreenUpdating = True
   
   

    Close #1


End Sub

liulang0808

文本写入.zip (479.76 KB, 下载次数: 4)

2023-6-5 12:12 上传

点击文件名下载附件

楼主的需求描述，真是不太懂，试着套用了下，供参考

天地一相

liulang0808 发表于 2023-6-5 12:13
楼主的需求描述，真是不太懂，试着套用了下，供参考

大神，感谢啊！！！做出来了。估计还是我描述的不精准，你的代码只出现了语句位置的2个小问题。我把新建打开文本的句子往下移动到了for a 下面，把关闭文本的句子往上移动到了next b 与 next a 之间，多次多任务测试，结果完全正确！！！感谢感谢再感谢。恭祝万事顺心啊。今天超级开心，攻克了一个长期琢磨的难题。感谢所有伸过援手的网友。

天地一相

liulang0808 发表于 2023-6-5 12:13
楼主的需求描述，真是不太懂，试着套用了下，供参考

谢谢，还得麻烦你一下，即将 Close #1 之前，是否有便捷的办法知道一共写入了多少行数据，并写在A1。现在我是用两个公式，一个是单次统计有多少个符合，另一个公式是累加这些计数。这两个公式在运行过程中就在不停的统计计算，我只是猜想会多耗费时间。

liulang0808

天地一相 发表于 2023-6-5 16:10
谢谢，还得麻烦你一下，即将 Close #1 之前，是否有便捷的办法知道一共写入了多少行数据，并写在A1。现在 ...

设置一个变量用来记录条数就可以了吧
在代码开始初始化

天地一相

liulang0808 发表于 2023-6-5 16:53
设置一个变量用来记录条数就可以了吧
在代码开始初始化

我不会，给一句呗。