excel通过宏vb生成模板txt文件
最新回答
你会腻我何必
2025-06-27 01:42:02
初学VBA程序，也就来试试，代码如下：
Sub abcd()
Dim i, str1, str2, str3, str4, str5, str6, str7, str8, str9
On Error Resume Next
Set mysheet1 = ThisWorkbook.Worksheets("Sheet1")
Set fs = CreateObject("Scripting.FileSystemObject")
Set fi = fs.CreateTextFile("d:\Code123.txt", True) '在D盘里边创建 Code123.txt
For i = 1 To 1000 '从第一行到1000行
If mysheet1.Cells(i, 1) <> "" And mysheet1.Cells(i, 2) <> "" Then '如果单元格不为空白则：
str1 = "[User]"
str2 = "uid=" & mysheet1.Cells(i, 1)
str3 = "last_name=" & mysheet1.Cells(i, 2)
str4 = "frist_name=" & mysheet1.Cells(i, 3)
str5 = "accessibility=" & mysheet1.Cells(i, 4)
str6 = "password=" & mysheet1.Cells(i, 5)
str7 = "SAPME:DEFAULT SITE=" & mysheet1.Cells(i, 6)
str8 = "role=" & mysheet1.Cells(i, 7)
str9 = "group=" & mysheet1.Cells(i, 8)
fi.WriteLine (str1)
fi.WriteLine (str2)
fi.WriteLine (str3)
fi.WriteLine (str4)
fi.WriteLine (str5)
fi.WriteLine (str6)
fi.WriteLine (str7)
fi.WriteLine (str8)
fi.WriteLine (str9)
End If
Next
fi.Close
End Sub
程序截图如下：
执行结果如下：
考考死
2025-06-27 00:38:29
Sub txt工具()
Const path1 = "excel数据源"
Const path2 = "txt结果"
Dim sj(1 To 100000, 1 To 2) '1-日期 2-开盘价
Application.ScreenUpdating = False
If ActiveSheet.Name <> "工具" Then Exit Sub
'清空结果文件
'mypath = ThisWorkbook.Path & "\" & path2
'Kill mypath & "\*.*"
'读取数据源
mypath = ThisWorkbook.path & "\" & path1
mypath2 = ThisWorkbook.path & "\" & path2
myfile = Dir(mypath & "\" & "*.xls*")
Do While myfile <> ""
If myfile = "" Then
Exit Do '当MyFile为空的时候就说明已经遍历完了，这时退出Do，否则还要运行一遍
End If
Set wb = Workbooks.Open(mypath & "\" & myfile)
For Each mys In wb.Sheets
shtname = mys.Name
arr = Split(myfile, ".")
txtname = arr(0) & "-" & shtname
ZZ = 1
Do While mys.Cells(2 + ZZ, 1) <> ""
sj(ZZ, 1) = mys.Cells(2 + ZZ, 1)
sj(ZZ, 2) = Round(mys.Cells(2 + ZZ, 2), 4)
ZZ = ZZ + 1
Loop
'*************
Set fs = CreateObject("Scripting.FileSystemObject")
filePath = mypath2 & "\" & txtname & ".txt"
fs.CreateTextFile filePath
Open filePath For Output As #1
Print #1, "日期,开盘价"
For j = 1 To ZZ - 1
mystr = Format(sj(j, 1), "yyyy-mm-dd") & "," & Format(sj(j, 2), "0.00%")
Print #1, mystr
Next j
Close #1
Set f = Nothing
Set fs = Nothing
Next mys
wb.Close False
myfile = Dir '第二次读入的时候不用写参数
Loop
Application.ScreenUpdating = True
End Sub
‘3030490161
热门标签
