求一个宏:能生成相应的txt文件的.
问题如下:
在excle中有两个工作表:
一个是固定的(在宏里用数组也是可以的,因为基本不变):
城市代码 城市
D100 BEIJING
D101 SHANGHAI
D102 TIANJIN
D103 CHONGQING
另一张表的行数是不确定的:
城市 商品代码 商品 计量单位 价格
BEIJING MU1001 EGG GE 10
SHANGHAI MU1002 APPLE GE 10
TIANJIN MU1003 ORANGE GE 10
CHONGQING MU1004 BANANA GE 10
想生成一个txt文件,格式如下(值之间用,分隔):
城市代码,月份,计量单位,商品代码,价格
其中,月份由一个弹出窗口选择,弹出窗口中还可选保存路径或是保存到c盘个目录下也可以.
因每月的工作中都要用,要是能帮我解决可是帮了我大忙了.谢谢先
[解决办法]
把第二个表的格式改下,用城市名称寻找城市代码不科学,那样计算会慢.
月份城市代码城市商品代码商品计量单位价格
1D100BEIJINGMU1001EGGGE10
1D101SHANGHAIMU1002APPLEGE10
1D102TIANJINMU1003ORANGEGE10
1D103CHONGQINGMU1004BANANAGE10
代码:
Sub 导出txt()
Set fs = CreateObject( "Scripting.FileSystemObject ")
Set a = fs.CreateTextFile( "D:\01.txt ", True)
Myn = Application.WorksheetFunction.CountA(Sheets( "02 ").Range( "A2:A10000 "))
For n = 1 To Myn
My1 = Sheets( "02 ").Cells(n, 1)
My2 = Sheets( "02 ").Cells(n, 3)
My3 = Sheets( "02 ").Cells(n, 4)
My4 = Sheets( "02 ").Cells(n, 5)
My5 = Sheets( "02 ").Cells(n, 6)
a.WriteLine My1 & ", " & My2 & ", " & My3 & ", " & My4 & ", " & My5
Next n
End Sub
[解决办法]
你的办法好像行得通,按用户的选择来执行计算.
我更改了一下,可能更能达到各位要求.
sht = InputBox( "请输入要保存的路径与文件名,填写时注意目录是否存在以及路径标识正确性。如‘D:\0701’ ", "导出提示 ") '
Open sht & ".txt " For Output As #1
Myn = Sheets( "02 ") .[D65536].End(xlUp).Row
For n = 1 To Myn
My1 = Sheets( "02 ").Cells(n, 1)
My2 = Sheets( "02 ").Cells(n, 2)
My3 = Sheets( "02 ").Cells(n, 3)
My4 = Sheets( "02 ").Cells(n, 4)
My5 = Sheets( "02 ").Cells(n, 5)
a.WriteLine My1 & ", " & My2 & ", " & My3 & ", " & My4 & ", " & My5
Next n
[解决办法]
Dim strFilePath As String
strFilePath = Application.GetSaveAsFilename( "Noname1 ", fileFilter:= "テキスト ファイル (*.txt), *.txt ")
If strFilePath = "False " Then Exit Sub
Dim intRow As Integer
intRow = 2
Open strFilePath For Output As #1
While Worksheets(1).Range( "A " & intRow).Value <> " "
Write #1, Application.WorksheetFunction.VLookup(Worksheets(2).Range( "A " & intRow), _
Worksheets(1).Range( "A:B "), 2, False), _
Worksheets(2).Range( "B " & intRow).Value, _
Worksheets(2).Range( "C " & intRow).Value, _
Worksheets(2).Range( "D " & intRow).Value, _
Worksheets(2).Range( "E " & intRow).Value
intRow = intRow + 1
Wend
Close #1
