把EXCEL数据导入到txt文档中的指定位置。谢谢liulang0808和一把小刀闯天下老师

xd3210

lhj323323 发表于 2019-1-18 20:30
xd3210老师：
是如下图这般写入代码吗？
但运行时，要报错

插入一个模块，把代码粘贴到模块中，运行wrini过程

一把小刀闯天下

lhj323323 发表于 2019-1-18 21:27
“liulang0808”和“一把小刀闯天下”老师
非常感谢两位老师的热心帮助，一楼的求助需求均是正确的！

Option Explicit

Sub test()
    Dim filename, i, j, arr, brr(), crr, cnt
    filename = ThisWorkbook.Path & "\mk.txt"
    If Dir(filename) = vbNullString Then MsgBox filename: Exit Sub
    Open filename For Input As #1
    arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
    Close #1
    ReDim brr(10 * UBound(arr))
    crr = [a1].CurrentRegion
    For i = 0 To UBound(arr)
      If Len(arr(i)) = 0 Then Exit For
      If arr(i) = "[TIP]" Then
        For j = 2 To UBound(crr, 1)
          cnt = cnt + 1
          brr(cnt) = String(7 - Len(crr(j, 1)), "0") & crr(j, 1) & "=7"
        Next
      End If
      cnt = cnt + 1: brr(cnt) = arr(i)
    Next
    If brr(cnt) <> "[TRD]" Then cnt = cnt + 1: brr(cnt) = "[TRD]"
    For i = 2 To UBound(crr, 1)
      cnt = cnt + 1
      brr(cnt) = String(7 - Len(crr(i, 1)), "0") & crr(i, 1) & "=" & crr(i, 2)
    Next
    Dim dic, m
    Set dic = CreateObject("scripting.dictionary")
    For i = 1 To cnt
      If Not dic.exists(brr(i)) Then
        m = m + 1: brr(m) = brr(i)
        dic(brr(i)) = i
      End If
    Next
    ReDim Preserve brr(m)
    arr = Mid(Join(brr, vbNewLine), 3)
    Open filename For Output As #1
    Print #1, arr
    Close #1
End Sub

lhj323323

好奇怪，我于昨天（18号），针对三位老师的回复贴，一一作了测试回馈情况，并送了鲜花，共计回复了4层楼，即现在应该是9楼，但是现在（19号16点55分），我昨天回复的内容全部消失了，仍只有5层楼。

lhj323323

一把小刀闯天下 发表于 2019-1-19 09:02
Option Explicit

Sub test()

再次谢谢小刀老师！
测试完全正确了！！！

xd3210

lhj323323 发表于 2019-1-19 16:55
好奇怪，我于昨天（18号），针对三位老师的回复贴，一一作了测试回馈情况，并送了鲜花，共计回复了4层楼， ...

API方法试验成功没有？
上传了附件，请测试