Question

这张图片是我的excel数据格式，我想把它导出到固定列宽的文本文件中，例如：

libqt5webkit5-dev

当总是打开新创建的特定名称工作簿时，如何设置PERSONAL.XLSB自动运行我的脚本？

我尝试将此脚本添加到XLSB＆gt; ThisWorkBook

User ID    Total     Work
001        22:00     17:00
002        4:00      4:00

打开特定名称工作簿后，导出文本文件而不导出数据：

Private WithEvents App As Application

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    Application.Run ("PERSONAL.XLSB!TASUBSPayroll")
End Sub

我认为它只是在PERSONAL.XLSB上运行宏而不是运行到我的特定名称工作簿。

http://i.imgur.com/EETLL6V.jpg

我将这些代码添加到模块名称中作为＆＃34; TASUBSMacro＆＃34;在VBAProject（PERSONAL.XLSB）中，它仍然没有运行TotalTimeCardReport.xlsx的宏。

User ID    Total     Work

此TotalTimeCardReport.xlsx是从某些软件导出的，并使用excel自动打开它。但我与PERSONAL.XLSB结合使用，它仍然没有运行从PERSONAL.XLSB到TotalTimeCardReport.xlsx的宏模块。

Answer 1

循环所有行和所有单元格。将每个值发送到padspace函数。为每个单元格值构建字符串，并在单元格值之后填充空格。

您必须添加对工作簿的引用。在VBA IDE中，转到工具下拉菜单并选择引用。然后向下滚动并选择＆＃34; Microsoft Scripting Runtime＆＃34;。然后点击OK。

将填充空间函数调用参数调整为适合电子表格中数据的数字。因此，您将使用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

'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

如果您只想定位某些行和列，则可以在循环时测试值。然后定位列。这样的事情。

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

对用户问题的回复。在工作簿上运行宏。

Private Sub Workbook_Open()
    Run "MyMacro"
End Sub

＆＃34; MyMacro＆＃34;是公共模块Insert - ＆gt;中的过程的名称。模块。

如果您想从私有模块运行代码，则无法使用＆＃34;运行＆＃34;命令只使用过程名称。

Private Sub Workbook_Open()
    MyMacro
End Sub

Excel VBA导出到具有固定列宽+仅指定行和列的文本文件+转置

1 个答案: