Excel VBA导出为固定列宽度的文本文件+仅指定行和列+转置 [英] Excel VBA Export To Text File with Fixed Column Width + Specified Row and Columns Only + Transpose
问题描述
这张照片是我的excel数据格式，我想将其导出为固定列宽的文本文件，例如：
用户ID总额
001 22:00 17:00
002 4:00 4:00
如何设置PERSONAL.XLSB始终打开新创建的特定名称工作簿时自动运行我的脚本？
我尝试添加这个脚本进入XLSB> ThisWorkBook
Private WithEvents App As Application
Private Sub App_WorkbookOpen工作簿）
Application.Run（PERSONAL.XLSB！TASUBSPayroll）
End Sub
打开特定名称工作簿后，导出文本文件，不导出数据：
用户ID总计工作
我认为它仅在PERSONAL.XLSB上运行宏，而不是运行到我的特定名称工作簿。
http://i.imgur.com/EETLL6V.jpg
我将这些代码添加到在VBAProject（PERSONAL.XLSB）中，模块名称为TASUBSMacro，但它仍然不运行TotalTimeCardReport.xlsx的宏。
Private Sub Workbook_Open（）
运行MyMacro
End Sub
此TotalTimeCardReport.xlsx从某些软件导出，并使用excel自动打开。但是我结合了PERSONAL.XLSB，并没有将PERSONAL.XLSB的宏模块运行到TotalTimeCardReport.xlsx。
循环所有行和所有单元格。将每个值发送到padspace函数。为每个单元格构建字符串，并在单元格值之后填充空格。
您将必须添加对工作簿的引用。在VBA IDE中，转到工具下拉菜单并选择参考。然后向下滚动并选择Microsoft Scripting Runtime。然后点击OK。
将pad space函数调用参数调整为适合您的电子表格中的数据的数字。所以你可以用padspace调用更改20行。 PadSpace（20，len（cellValue））
这将执行所有行和列。
Public Sub MyMacro（）
Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'创建要写入
的文本文件设置fs =新建FileSystemObject
设置ts = fs.CreateTextFile （C：\Temp\test.txt，True，False）
设置ws = Application.ActiveSheet
'循环遍历所有行。
lRow = 1
Do While lRow< = ws.UsedRange.Rows.count
'清除我们正在建立的字符串
strRow =
'循环当前行的所有列。
lCol = 1
尽管lCol< = ws.UsedRange.Columns.count
'构建一个字符串来写出来。
strRow = strRow& ws.Cells（lRow，lCol）& PadSpace（20，Len（ws.Cells（lRow，lCol）））
lCol = lCol + 1
循环
'将行写入文本文件
ts.WriteLine strRow
lRow = lRow + 1
ws.Range（A& lRow）。激活
循环
ts.Close ：设置ts = Nothing
设置fs = Nothing
End Sub
'此函数将获取所需的最大空格数和字符串的长度单元格并返回您填充的空格字符串。
公共功能PadSpace（nMaxSpace As Integer，nNumSpace As Integer）As String
如果nMaxSpace< nNumSpace然后
PadSpace =
Else
PadSpace =空格（nMaxSpace - nNumSpace）
结束如果
结束函数
如果您只想定位某些行和列，您可以在循环时测试值。然后定位列。这样的东西。
Public Sub MyMacro（）
Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'创建文本文件写入
设置fs =新建FileSystemObject
设置ts = fs.CreateTextFile（C：\Temp\test.txt，True，False）
设置ws = Application.ActiveSheet
'写入头行
strRow =User ID& PadSpace（20，Len（User ID））
strRow = strRow& 总计& PadSpace（20，Len（Total））
strRow = strRow& 工作& PadSpace（20，Len（Work））
ts.WriteLine strRow
'循环遍历所有行。
lRow = 1
Do While lRow< = ws.UsedRange.Rows.Count
'清除我们正在建立的字符串
strRow =
如果ws.Range（A& lRow）.Value =用户ID然后
'构建要导出的字符串
strRow = ws.Range（ B& lRow）.Value& PadSpace（20，Len（ws.Range（B& lRow）.Value））
strRow = strRow& ws.Range（F& lRow + 2）.Value& PadSpace（20，Len（ws.Range（F& lRow + 2）.Value））
strRow = strRow& ws.Range（F& lRow + 3）.Value& PadSpace（20，Len（ws.Range（F& lRow + 3）.Value））
'将行写入文本文件
ts.WriteLine strRow
结束如果
lRow = lRow + 1
ws.Range（A& lRow）。激活
循环
ts.Close：Set ts = Nothing
设置fs = Nothing
End Sub
公共功能PadSpace（nMaxSpace As Integer，nNumSpace As Integer）As String
如果nMaxSpace< nNumSpace然后
PadSpace =
Else
PadSpace =空格（nMaxSpace - nNumSpace）
结束如果
结束函数
回复用户问题。要运行工作簿上的宏打开。
Private Sub Workbook_Open（）
运行MyMacro
结束Sub
MyMacro是公共模块中插入 - >模块的过程名称。 p>
如果要从私人模块运行代码，您不能使用运行命令，只需使用过程名称。
Private Sub Workbook_Open（）
MyMacro
End Sub
This picture is my excel data format, I wanna export it into text file with fixed column width, example:
User ID Total Work
001 22:00 17:00
002 4:00 4:00
How to set PERSONAL.XLSB auto run my script when always open a newly created specific name workbook?
I tried to add this script into XLSB > ThisWorkBook
Private WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Application.Run ("PERSONAL.XLSB!TASUBSPayroll")
End Sub
After open the specific name workbook, it was exported a text file without export the data out:
User ID Total Work
I think it was run the macro on PERSONAL.XLSB only and not run to my specific name workbook.
http://i.imgur.com/EETLL6V.jpg
I was add the these code into the module name as "TASUBSMacro" in VBAProject(PERSONAL.XLSB) but it still not run the macro for the TotalTimeCardReport.xlsx.
Private Sub Workbook_Open()
Run "MyMacro"
End Sub
This TotalTimeCardReport.xlsx was exported from some software and auto open it with excel. But I was combined with the PERSONAL.XLSB and it was still not run the macro - module from PERSONAL.XLSB to TotalTimeCardReport.xlsx.
Loop all rows and all cells. Send each value to a padspace function. Build the string from for each cells value with spaces padded after the cell value.
You will have to add a reference to you workbook. In the VBA IDE go to the tools pull down menu and select references. Then scroll down and select "Microsoft Scripting Runtime". Then hit OK.
Adjust the pad space function call argument to a number that fits the data that you have in your spreadsheet. So you will change the 20 in the line with the padspace call. PadSpace(20, len(cellValue))
This will do all rows and columns.
Public Sub MyMacro()
Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)
Set ws = Application.ActiveSheet
'Loop through all the rows.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.count
'Clear the string we are building
strRow = ""
'Loop through all the columns for the current row.
lCol = 1
Do While lCol <= ws.UsedRange.Columns.count
'Build a string to write out.
strRow = strRow & ws.Cells(lRow, lCol) & PadSpace(20, Len(ws.Cells(lRow, lCol)))
lCol = lCol + 1
Loop
'Write the line to the text file
ts.WriteLine strRow
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
ts.Close: Set ts = Nothing
Set fs = Nothing
End Sub
'This function will take the max number of spaces you want and the length of the string in the cell and return you the string of spaces to pad.
Public Function PadSpace(nMaxSpace As Integer, nNumSpace As Integer) As String
If nMaxSpace < nNumSpace Then
PadSpace = ""
Else
PadSpace = Space(nMaxSpace - nNumSpace)
End If
End Function
If you only want to target certain rows and columns you can test for values as you loop. And then target columns. Something like this.
Public Sub MyMacro()
Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)
Set ws = Application.ActiveSheet
'Write the header row
strRow = "User ID" & PadSpace(20, Len("User ID"))
strRow = strRow & "Total" & PadSpace(20, Len("Total"))
strRow = strRow & "Work" & PadSpace(20, Len("Work"))
ts.WriteLine strRow
'Loop through all the rows.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count
'Clear the string we are building
strRow = ""
If ws.Range("A" & lRow).Value = "User ID" Then
'Build the string to export
strRow = ws.Range("B" & lRow).Value & PadSpace(20, Len(ws.Range("B" & lRow).Value))
strRow = strRow & ws.Range("F" & lRow + 2).Value & PadSpace(20, Len(ws.Range("F" & lRow + 2).Value))
strRow = strRow & ws.Range("F" & lRow + 3).Value & PadSpace(20, Len(ws.Range("F" & lRow + 3).Value))
'Write the line to the text file
ts.WriteLine strRow
End If
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
ts.Close: Set ts = Nothing
Set fs = Nothing
End Sub
Public Function PadSpace(nMaxSpace As Integer, nNumSpace As Integer) As String
If nMaxSpace < nNumSpace Then
PadSpace = ""
Else
PadSpace = Space(nMaxSpace - nNumSpace)
End If
End Function
Response to user question. To run a macro on workbook open.
Private Sub Workbook_Open()
Run "MyMacro"
End Sub
"MyMacro" is the name of the procedure in a public module Insert -> Module.
If you want to run code from a private module you cannot use "Run" command just use the procedure name.
Private Sub Workbook_Open()
MyMacro
End Sub
这篇关于Excel VBA导出为固定列宽度的文本文件+仅指定行和列+转置的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
