2009-01-23 53 views
2

我的任务是为我们的财务部门创建可重复使用的流程,将我们的工资单上传到州(威斯康星州)进行报告。我需要创建一些在Excel中使用表格或范围并创建特定格式的文本文件。将Excel范围/工作表导出为格式化文本文件

THE FORMAT

  • 列1 - 的静态编号,从不改变,位置1-10
  • 列2 - 动态帕拉姆填充在运行时为四分之一/年,11-位置13
  • 柱3 - SSN,没有连字符或空格, 从柱的填充,位置14-22
  • 柱4 - 姓,从 ç填充olumn B,在10截断,左 对齐&填补空白,位置 23-32
  • 柱5 - 名字,从C, 截断为8,左填充对齐&填充 用空格,位置33-40 6
  • 柱 - 总工资总额/区,从 填充d,去除所有的格式, 右对齐零填充,位置 41-49
  • 柱7 - 一种静态代码,从未 变化,位置50-51
  • 第8栏 - 空格键,有填空, 位置52-80

我有,我想,3个选项:

  1. VBA
  2. .NET
  3. SQL

我已经探索了.NET方法,但我找不到像样的文档让我走。我仍然喜欢这个,但我离题了。

接下来我有一些VBA将转储到固定宽度文本的工作表。我目前正在追求这一点,最终导致我的实际问题。

如何在Excel中转​​换文本范围?我是否需要将它粘贴到另一张纸上,然后使用neccesarry格式化函数将该数据传递给我的转储到文本例程?我目前已经计划为每列提供一个函数,但是我很难弄清楚如何进行下一步操作。我在Office编程和一般开发方面相当新,所以任何见解都将不胜感激。

SQL选项可能会倒退,因为过去我从SQL执行过类似的导出操作。我只是比较喜欢其他两个,“我不想负责运行这个”,原理。

在任何时间提前致谢。

+0

优秀的问题和答案。 – 2009-01-27 01:53:03

回答

4

使用VBA似乎是要走我的路。这可以让你编写一个处理所有各种格式化选项的宏,并且希望对于你的财务人员来说可以很简单。

你说你需要一些在Excel中使用表格或范围的东西。第一列从不改变,所以我们可以将其存储在宏中,第3-7列来自电子表格,而第8列只是空白。这留下第2列(季度/年为QYY)作为一个问题。如果在工作簿中某处指定了季度/年份(例如存储在单元格中,作为工作表名称,作为工作簿标题的一部分),那么我们可以将其读入。否则,您需要找到一些方法来指定季度/年,当宏运行(例如弹出一个对话框,要求用户输入的话)

一些简单的代码(我们会担心如何调用这个版本):

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中输出到文件,我们需要获取文件句柄,因此我们需要一个变量来存储它。我们将在报告行字符串中构建报告的每一行,并使用行索引在范围内工作

' 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 

这些变量集分别存储工作表的原始数据和要输出到文件的清理数据。将它们命名为“原始”和“干净”,可以更容易地发现意外输出原始数据而非清理数据的错误。我们需要改变从一个字符串值的原始工资为一个数值,以帮助格式化

' 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 

在我们遍历各行的工作,我们开始通过清除输出字符串,然后添加在值列​​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), "[email protected]@@@@@@@@@") 
strPayrollReportLine = strPayrollReportLine & strCleanLastName 

strRawFirstName = rngPayrollData.Cells(indexRow, 3) 
strCleanFirstName = Format(Left$(strRawFirstName, 8), "[email protected]@@@@@@@") 
strPayrollReportLine = strPayrollReportLine & strCleanFirstName 

Left$(string, length)截断字符串指定的长度。该格式图片[email protected]@@@@@@@@@格式的字符串作为正好十个字符,左对齐(的!表示左对齐),并用空格填充

' 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的格式的图片垫令人惊讶的是

' 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)功能0产生变体,与指定的charnumber的序列。 CStr将Variant变成一个字符串。该Print #声明输出到文件,无需任何额外的格式

Next indexRow 

' Close the file 
Close #fnOutPayrollReport 

End Sub 

循环轮的范围和重复下一行。当我们处理了所有行时,关闭文件并结束宏我们仍然需要两件事:一个cleanFromRawSSN函数和一个用相关数据调用宏的方法。

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返回字符串和从stringMid$(string, start, length)返回length字符在start开始的长度。此功能可以改善,因为它目前不检查非数字数据

要调用宏:

Sub CallPayrollReport() 

ProduceStatePayrollReportFile Application.Selection, "1234560007", "109", "01", "C:\payroll109.txt" 

End Sub 

这是调用它的最简单方法。范围是用户在活动工作簿中的活动工作表上选择的任何值,其他值是硬编码的。用户应该选择他们想输出到文件的范围,然后进入工具>宏>运行,然后选择CallPayrollReport。为此,宏需要成为包含数据的工作簿的一部分,或者需要在用户调用宏之前加载的不同工作簿中。

有人需要在每季度报告生成之前更改季度/年份的硬编码值。如前所述,如果季度/年已经存储在工作簿,然后某处这是更好的阅读,在而不是硬编码

希望是有道理的,是一些使用的

-1

根据您的文档格式,我可能会建议导出到.csv并使用它。如果你需要的只是数字,这将是最简单的方法。

+0

感谢您的回答。我相信我很困惑。你指的是什么文件的“格式”?我试图在我的文章中概述这一点。其次,通过将我的xls变成csv可以获得什么? 再次感谢! – 2009-01-23 20:06:29

0

从最简单的角度思考这个问题,并且如果您熟悉SQL,在Access的上下文中,您可以使用Access作为外部数据源附加到电子表格。它看起来像Access中的一张桌子,并从那里开始工作。

0

哇!我不得不说,我被吹走了。你远远超出了我的期望,答案是我感到内疚,我只能投票给你一次,并且标记为例外。我曾经希望能够获得最佳路径和某些格式的指导。祝我生日快乐!

Format()和FreeFile()是特别新的有用信息。此外,为了表明我正在尝试,我的尝试如下。我非常接近,因为我只是在制定格式细节,但我相信我会用您的意见来修改它,因为它似乎是更优雅的方法。

作为最后的笔记。我通过Jeff Atwood的博客找到了这个地方,我对这个想法感到非常兴奋。作为一个独立商店中缺乏经验的新开发者,我一直希望有一个地方可以转向指导。书籍和文章让你明白,但没有什么等于某人完成了它或曾经在那里的建议。到目前为止,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 

0

,正如更新:我能够用我和所有啮合。这很好。

我将其添加到工具栏菜单中以便于调用,并将保存部分更改为自动在此处找到桌面并保存文件。追加通过已过滤的输入框输入的Quarter YEar变量的值。

我想尝试摆脱他们不得不选择活动区域,但根据所涉及的工作,这可能不值得我花时间进行投资。 (Solo店和所有)沿着同样的路线,它会很高兴有更多的错误捕捉,因为它是目前相当脆弱,但唉....

再次感谢!

相关问题