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

lhj323323 · 发表于 2024-2-21 15:04

本帖最后由 lhj323323 于 2024-2-21 15:50 编辑

老师：

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

请看下图
快照5.png

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

请老师帮忙！谢谢了。

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

Sub test0()
Dim ar, i As Long, k As Long
Dim s As String, t As String
ar = Range("A1").CurrentRegion.Offset(1).Value
For i = 1 To UBound(ar) - 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, ")") & ";"
Open ThisWorkbook.Path & "\tes.txt" For Output As #1
Print #1, Mid(t, 2)
Close #1
End Sub

复制代码

lhj323323 · 发表于 2024-2-21 15:50

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

完全正确，多谢老师！

ykcbf1100 · 发表于 2024-2-21 15:57

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

蓝桥玄霜 · 发表于 2024-2-21 15:58

文本的例子：

lhj323323 · 发表于 2024-2-21 16:10

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

老师：

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

fzxba · 发表于 2024-2-21 16:35

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 · 发表于 2024-2-21 16:38

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

lhj323323 · 发表于 2024-2-21 18:44

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 19:08

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

谢谢蓝桥老师！

鲜花明日奉上

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

[已解决] 超难的导出规则，生成txt，谢谢fzxba老师！

评分

评分

评分

评分

评分