将Excel范围/工作表导出为格式化的文本文件
我的任务是为财务部门创build一个可重复使用的stream程，将我们的薪资上传到州（WI）进行报告。 我需要在Excel中创build一个表格或范围，并创build一个特定格式的文本文件。
格式
- 第1列 – 一个静态数字，从不改变位置1-10
- 第2列 – dynamic参数在运行时填入季度/年份，位置11-13
- 第3列 – SSN，没有连字符或空格，从第A列14-22位填入
- 第4列 – 姓氏，从列B填充，截断为10，左alignment，填充空白，位置23-32
- 第5栏 – 名字，由C填写，截断为8，左alignment填空，位置33-40
- 第6栏 – 总工资总额/季度，由D填写，删除所有格式，右alignment零填写，位置41-49
- 第7列 – 一个静态代码，从来没有改变，位置50-51
- 第8栏 – 空白，填充空格，位置52-80
我有，我假设，3个选项：
- VBA
- 。净
- SQL
我已经探索了.NET的方法，但我只是找不到像样的文档让我去。 我仍然喜欢这个，但我离题了。
接下来，我有一些VBA将转储到固定宽度的文本的工作表。 我目前正在追求这一点，最终导致我的实际问题。
如何在Excel中转换一系列文本？ 我是否需要把它翻到另一张纸上，然后用neccesarry格式化函数将数据传递给我的转储到文本例程？ 我目前已经计划为每一列提供一个函数，但是我很难弄清楚如何进行下一步操作。 我在Office编程和一般开发相当新，所以任何有识之士将不胜感激。
SQL选项可能会倒退，因为我过去曾经从SQL执行类似的输出。 我只是比较喜欢其他两个， “我不想为这个运行负责”的原则。
在任何时候提前感谢。
使用VBA似乎是去我的路。 这可以让你编写一个处理所有各种格式化选项的macros，而且希望对你的财务人员来说可以很简单。
你说你需要一些在Excel中使用表格或范围的东西。 第一列从不改变，所以我们可以将其存储在macros中，第3-7列来自电子表格，第8列只是空白。 这留下第2列（季度/年为QYY）作为一个问题。 如果在工作簿中某处指定了季度/年份（例如存储在单元格中，作为工作表名称，作为工作簿标题的一部分），那么我们可以只读取它。否则，您将需要find一些方法来指定季度/运行macros的年份（例如，popup一个对话框并要求用户input）
一些简单的代码（我们将担心以后如何调用这个代码）：
Sub ProduceStatePayrollReportFile(rngPayrollData As Range, strCompanyNo As String, _ strQuarterYear As String, strRecordCode As String, strOutputFile As String) 参数非常明显：包含数据的范围，列1的公司编号，列2的季度/年，列7的固定代码以及要将结果输出到的文件
' Store the file handle for the output file Dim fnOutPayrollReport As Integer ' Store each line of the output file Dim strPayrollReportLine As String ' Use to work through each row in the range Dim indexRow As Integer
要在VBA中输出到一个文件，我们需要得到一个文件句柄，所以我们需要一个variables来存储它。我们将在报告行string中构build报告的每一行，并使用行索引来处理范围
' Store the raw SSN, last name, first name and wages data Dim strRawSSN As String Dim strRawLastName As String Dim strRawFirstName As String Dim strRawWages As String Dim currencyRawWages As Currency ' Store the corrected SSN, last name, first name and wages data Dim strCleanSSN As String Dim strCleanLastName As String Dim strCleanFirstName As String Dim strCleanWages As String
这些variables集分别存储来自工作表的原始数据和要输出到文件的清理数据。 将它们命名为“原始”和“干净”，可以更容易地发现意外输出原始数据而不是清除数据的错误。 我们需要将原始工资从string值更改为数值，以帮助格式化
' Open up the output file fnOutPayrollReport = FreeFile() Open strOutputFile For Output As #fnOutPayrollReport
FreeFile（）获取下一个可用的文件句柄，我们用它来链接到文件
' Work through each row in the range For indexRow = 1 To rngPayrollData.Rows.Count ' Reset the output report line to be empty strPayrollReportLine = "" ' Add the company number to the report line (assumption: already correctly formatted) strPayrollReportLine = strPayrollReportLine & strCompanyNo ' Add in the quarter/year (assumption: already correctly formatted) strPayrollReportLine = strPayrollReportLine & strQuarterYear
在循环遍历每一行，我们首先清除输出string，然后添加列1和2的值
' Get the raw SSN data, clean it and append to the report line strRawSSN = rngPayrollData.Cells(indexRow, 1) strCleanSSN = cleanFromRawSSN(strRawSSN) strPayrollReportLine = strPayrollReportLine & strCleanSSN
.Cells(indexRow, 1)部分只是表示indexRow指定的行范围的最左边一列。 如果范围从列A开始（不一定是这种情况），那么这只是意味着A.我们将需要稍后编写cleanFromRawSSN函数
' Get the raw last and first names, clean them and append them strRawLastName = rngPayrollData.Cells(indexRow, 2) strCleanLastName = Format(Left$(strRawLastName, 10), "!@@@@@@@@@@") strPayrollReportLine = strPayrollReportLine & strCleanLastName strRawFirstName = rngPayrollData.Cells(indexRow, 3) strCleanFirstName = Format(Left$(strRawFirstName, 8), "!@@@@@@@@") strPayrollReportLine = strPayrollReportLine & strCleanFirstName
Left$(string, length)将string截断为给定的长度。 格式图片!@@@@@@@@@@格式化一个string，正好是十个字符，左alignment（！表示左alignment）并填充空格
' Read in the wages data, convert to numeric data, lose the decimal, clean it and append it strRawWages = rngPayrollData.Cells(indexRow, 4) currencyRawWages = CCur(strRawWages) currencyRawWages = currencyRawWages * 100 strCleanWages = Format(currencyRawWages, "000000000") strPayrollReportLine = strPayrollReportLine & strCleanWages
我们把它转换成货币，这样我们可以乘以100来将美分值移到小数点左边。 这使得使用Format来生成正确的值变得更容易。 这将不会产生正确的输出工资> = 1000万美元，但这是用于报告的文件格式的限制。 格式图片中的0用0填充令人惊讶的足够
' Append the fixed code for column 7 and the spaces for column 8 strPayrollReportLine = strPayrollReportLine & strRecordCode strPayrollReportLine = strPayrollReportLine & CStr(String(29, " ")) ' Output the line to the file Print #fnOutPayrollReport, strPayrollReportLine
String(number, char)函数产生具有指定char序列number的变体。 CStr将Variant变成一个string。 Print #语句输出到文件没有任何额外的格式
Next indexRow ' Close the file Close #fnOutPayrollReport End Sub
循环到范围中的下一行并重复。 当我们处理了所有的行时，closures文件并结束macros
我们仍然需要两件事：一个cleanFromRawSSN函数和一个用相关数据调用macros的方法。
Function cleanFromRawSSN(strRawSSN As String) As String ' Used to index the raw SSN so we can process it one character at a time Dim indexRawChar As Integer ' Set the return string to be empty cleanFromRawSSN = "" ' Loop through the raw data and extract the correct characters For indexRawChar = 1 To Len(strRawSSN) ' Check for hyphen If (Mid$(strRawSSN, indexRawChar, 1) = "-") Then ' do nothing ' Check for space ElseIf (Mid$(strRawSSN, indexRawChar, 1) = " ") Then ' do nothing Else ' Output character cleanFromRawSSN = cleanFromRawSSN & Mid$(strRawSSN, indexRawChar, 1) End If Next indexRawChar ' Check for correct length and return empty string if incorrect If (Len(cleanFromRawSSN) <> 9) Then cleanFromRawSSN = "" End If End Function
Len返回string的长度， Mid$(string, start, length)从string开始处返回length字符。 这个function可以被改进，因为它目前不检查非数字数据
要调用macros：
Sub CallPayrollReport() ProduceStatePayrollReportFile Application.Selection, "1234560007", "109", "01", "C:\payroll109.txt" End Sub
这是调用它的最简单的方法。 范围是用户在活动工作簿中的活动工作表上select的任何值，其他值是硬编码的。 用户应该select他们想要输出到文件的范围，然后去工具>macros>运行，然后selectCallPayrollReport 。 为此，macros将或者需要成为包含数据的工作簿的一部分，或者在用户调用macros之前加载的另一个工作簿中。
在每个季度的报告生成之前，有人需要更改季度/年度的硬编码值。 如前所述，如果季度/年度已经存储在某个地方的工作簿中，那么最好是阅读而不是硬编码
希望是有道理的，有一定的用处
从最简单的angular度思考这个问题，如果你对SQL感兴趣，在Access的上下文中，可以使用Access作为外部数据源附加到电子表格。 它看起来像Access中的一张桌子，然后在那里工作。
哇！
我不得不说，我被吹走了。 你到目前为止超出了我的期望答案，我感到内疚，我只能投票你一次，并标记为例外。 我希望这样的指导是最好的path和一些格式。 祝我生日快乐！
格式（）和FreeFile（）是特别新的有用的信息。 此外，只是为了表明我正在尝试，我的尝试是在下面。 当时我正在研究格式细节，但是我相信我会用你的意见来修改它，因为看起来这是更加优雅的方法。
作为最后的说明。 我通过Jeff Atwood的博客find了这个地方，我对这个想法感到非常兴奋。 作为一个独立店里的新手，没有经验的开发人员，我一直希望有一个地方可以转向指导。 书籍和文章让你明白，但是没有任何东西等于某人完成或者到过那里的build议。 到目前为止，StackOverflow已经交付。
作为参考，我在另一个非常受欢迎的代码论坛上发布了完全相同的问题，并且还没有以任何方式收到单个回复。
现在我的尝试：
模块代码
Sub StateANSIIExport() Dim Sizes As Variant Dim arr As Variant Dim aRow As Long, aCol As Long Dim rowLimit As Integer, colLimit As Integer Dim SpacesPerCell As Integer Dim fso As Object Dim ts As Object Dim TheLine As String Dim TestStr As String arr = ActiveSheet.UsedRange rowLimit = UBound(arr, 1) 'colLimit = UBound(arr, 2) colLimit = 8 SpacesPerCell = 20 'Set export text "column" width here Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.CreateTextFile(GetDesktopPath() & "EXCELTEXT.txt", True) ' Loop thru the rows For aRow = 1 To rowLimit TheLine = Space(colLimit * SpacesPerCell) ' your fixed-width output ' Loop thru the columns For aCol = 1 To colLimit Select Case aCol Case 1 ' Employer UI Account # Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = "6979430002" Case 2 ' Reporting Period (QYY) Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = "109" Case 3 ' SSN Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "A") Case 4 ' Last Name Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "B") Case 5 ' First Name Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "C") Case 6 ' Employee Quartly Gross Wages Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = Cells(aRow, "D") Case 7 ' Record Code Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = "01" Case 8 ' BLANK Mid(TheLine, aCol * SpacesPerCell - SpacesPerCell + 1, SpacesPerCell) = " " End Select Next aCol ' Write the line to the file ts.WriteLine TheLine Next aRow ts.Close Set ts = Nothing Set fso = Nothing MsgBox "Done" End Sub Sub MacroToRunTwo() Dim S As String S = "Hello World From Two:" & vbCrLf & _ "This Add-In File Name: " & ThisWorkbook.FullName MsgBox S End Sub Function GetDesktopPath() As String 'Return the current user's desktop path GetDesktopPath = "C:\Users\patrick\Desktop\" 'GetDesktopPath = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Desktop\" End Function
和工作手册代码：
Private Const C_TAG = "Refracted Solutions" ' C_TAG should be a string unique to this add-in. Private Const C_TOOLS_MENU_ID As Long = 30007& Private Sub Workbook_Open() ''''''''''''''''''''''''''''''''''''''''''''''' ' Workbook_Open ' Create a submenu on the Tools menu. The ' submenu has two controls on it. ''''''''''''''''''''''''''''''''''''''''''''''' Dim ToolsMenu As Office.CommandBarControl Dim ToolsMenuItem As Office.CommandBarControl Dim ToolsMenuControl As Office.CommandBarControl ''''''''''''''''''''''''''''''''''''''''''''''' ' First delete any of our controls that ' may not have been properly deleted previously. ''''''''''''''''''''''''''''''''''''''''''''''' DeleteControls '''''''''''''''''''''''''''''''''''''''''''''' ' Get a reference to the Tools menu. '''''''''''''''''''''''''''''''''''''''''''''' Set ToolsMenu = Application.CommandBars.FindControl(ID:=C_TOOLS_MENU_ID) If ToolsMenu Is Nothing Then MsgBox "Unable to access Tools menu.", vbOKOnly Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''' ' Create a item on the Tools menu. '''''''''''''''''''''''''''''''''''''''''''''' Set ToolsMenuItem = ToolsMenu.Controls.Add(Type:=msoControlPopup, temporary:=True) If ToolsMenuItem Is Nothing Then MsgBox "Unable to add item to the Tools menu.", vbOKOnly Exit Sub End If With ToolsMenuItem .Caption = "&WWCares" .BeginGroup = True .Tag = C_TAG End With '''''''''''''''''''''''''''''''''''''''''''''' ' Create the first control on the new item ' in the Tools menu. '''''''''''''''''''''''''''''''''''''''''''''' Set ToolsMenuControl = ToolsMenuItem.Controls.Add(Type:=msoControlButton, temporary:=True) If ToolsMenuControl Is Nothing Then MsgBox "Unable to add item to Tools menu item.", vbOKOnly Exit Sub End If With ToolsMenuControl '''''''''''''''''''''''''''''''''''' ' Set the display caption and the ' procedure to run when clicked. '''''''''''''''''''''''''''''''''''' .Caption = "State ANSII E&xport" .OnAction = "'" & ThisWorkbook.Name & "'!StateANSIIExport" .Tag = C_TAG End With '''''''''''''''''''''''''''''''''''''''''''''' ' Create the second control on the new item ' in the Tools menu. '''''''''''''''''''''''''''''''''''''''''''''' 'Set ToolsMenuControl = ToolsMenuItem.Controls.Add(Type:=msoControlButton, temporary:=True) 'If ToolsMenuControl Is Nothing Then ' MsgBox "Unable to add item to Tools menu item.", vbOKOnly ' Exit Sub 'End If 'With ToolsMenuControl '''''''''''''''''''''''''''''''''''' ' Set the display caption and the ' procedure to run when clicked. '''''''''''''''''''''''''''''''''''' ' .Caption = "Click Me &Two" ' .OnAction = "'" & ThisWorkbook.Name & "'!MacroToRunTwo" ' .Tag = C_TAG 'End With End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Workbook_BeforeClose ' Before closing the add-in, clean up our controls. '''''''''''''''''''''''''''''''''''''''''''''''''''' DeleteControls End Sub Private Sub DeleteControls() '''''''''''''''''''''''''''''''''''' ' Delete controls whose Tag is ' equal to C_TAG. '''''''''''''''''''''''''''''''''''' Dim Ctrl As Office.CommandBarControl On Error Resume Next Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG) Do Until Ctrl Is Nothing Ctrl.Delete Set Ctrl = Application.CommandBars.FindControl(Tag:=C_TAG) Loop End Sub
就像一个更新：我能够与我的网格，一切都很好。
我将其添加到一个工具栏菜单，方便调用，并更改保存部分，以自动在那里find桌面和保存文件附加他们通过一个筛选的input框input的季YEARvariables的值。
我想尝试摆脱他们不得不select活跃的领域，但根据所涉及的工作可能不值得我的时间投资。 （Solo店和所有）沿着同样的路线，它会很高兴有更多的错误捕捉，因为它是相当脆弱的，但唉…
再次感谢！
根据您的文档格式，我可能会build议导出到.csv并使用它。 如果你需要的只是数字，这将是最简单的方法。