超难的导出规则，生成txt，谢谢fzxba老师！

lhj323323

老师：

上传的附件里有【写了一半】的半成品
对我来说，太难了。

请看下图


求助.rar (17.08 KB, 下载次数: 8)

2024-2-21 15:04 上传

点击文件名下载附件

请老师帮忙！谢谢了。

fzxba

1. 
   
2. Sub test0()
   
3.   Dim ar, i As Long, k As Long
   
4.   Dim s As String, t As String
   
5.   ar = Range("A1").CurrentRegion.Offset(1).Value
   
6.   For i = 1 To UBound(ar) - 1
   
7.     k = k + 1
   
8.     s = "IF(k=" & i & ",p(J" & i & "," & i - 1 & "),"
   
9.     t = t & Chr(10) & s
   
10.     If k = 5 Then
    
11.       t = t & "0" & String(k, ")") & ";" & Chr(10)
    
12.       k = 0
    
13.     End If
    
14.   Next
    
15.   If k Then t = t & "0" & String(k, ")") & ";"
    
16.   Open ThisWorkbook.Path & "\tes.txt" For Output As #1
    
17.   Print #1, Mid(t, 2)
    
18.   Close #1
    
19. End Sub

复制代码

lhj323323

fzxba 发表于 2024-2-21 15:41

完全正确，多谢老师！

ykcbf1100

写都写了，还是上传一下吧，就是速度慢一点

蓝桥玄霜

文本的例子：

lhj323323

fzxba 发表于 2024-2-21 15:41

老师：

运行程序后，能否把txt之前的内容也保留？

fzxba

lhj323323 发表于 2024-2-21 16:10
老师：

运行程序后，能否把txt之前的内容也保留？

Sub test1() '这个意思？
  Dim i As Long, j As Long, k As Long
  Dim s As String, t As String
  j = Range("A1").CurrentRegion.Rows.Count
  For i = 1 To j - 1
    k = k + 1
    s = "IF(k=" & i & ",p(J" & i & "," & i - 1 & "),"
    t = t & Chr(10) & s
    If k = 5 Then
      t = t & "0" & String(k, ")") & ";" & Chr(10)
      k = 0
    End If
  Next
  If k Then t = t & "0" & String(k, ")") & ";" & Chr(10) & Chr(10)
  
  With CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\test.txt", 8, -1)
    .Write Mid(t, 2)
    .Close
  End With
  'Open ThisWorkbook.Path & "\test.txt" For Output As #1
  'Print #1, Mid(t, 2)
  'Close #1
  Beep
End Sub

fzxba

代码审见附件.zip (18.64 KB, 下载次数: 6)

2024-2-21 16:38 上传

点击文件名下载附件

lhj323323

fzxba 发表于 2024-2-21 16:35
Sub test1() '这个意思？
  Dim i As Long, j As Long, k As Long
  Dim s As String, t As String

是这个意思。

谢谢老师！

lhj323323

蓝桥玄霜 发表于 2024-2-21 15:58
文本的例子：

谢谢蓝桥老师！

鲜花明日奉上