VBA 实例：汇总计算工资并按固定格式导出

汗，相当的纠结啊，科技部（还不如叫机房那边）的力量不够，发个成百户的工资，Excel单元格格式必须是文本，反正各种导入，才能成功，而对于文本格式，只要分隔符位置和数量正确，立马就能导入成功。

下面是根据某一代码改编而来的，功能：求和，账号长度验证、金额为空验证，导出为特定格式的txt。

Sub SumAmt()
    Dim nRow As Integer
    Dim dSum As Double
    dSum = 0
    For nRow = 5 To 30000
        If Cells(nRow, 1).Text = "" Then Exit For
        If Cells(nRow, 4).Text = "" Then
            MsgBox "第" & nRow & "行的 账号 没有输入"
            Exit For
            ElseIf (Len(Cells(nRow, 4).Text) < 15) Or (Len(Cells(nRow, 4).Text) > 17) Then
            MsgBox "第" & nRow & "行的 账号 长度不正确，账号为15-17位"
            Exit For
        End If
        If Cells(nRow, 6).Text = "" Then
            MsgBox "第" & nRow & "行的金额没有输入"
            Exit For
        End If
        dSum = dSum + Round(Cells(nRow, 6).Text, 2)
       ' dSum = dSum + Cells(nRow, 6).Text
       ' MsgBox (dSum)
    Next nRow
    Cells(1, 4).Value = dSum
End Sub
Sub Count()
    Dim nRow As Integer
    Dim nCount As Integer
    nCount = 0
    For nRow = 5 To 30000
        If Cells(nRow, 1).Text = "" Then Exit For
        nCount = nCount + 1
    Next nRow
    Cells(2, 4).Value = nCount
End Sub
Sub Convert2Text()
    Dim nRow As Integer, nCol As Integer, nColNum As Integer
    Dim strLine As String
    Dim fHandle As Integer, fLoginHandle As Integer, fFtpHandle As Integer
    Dim strFilename As String, strLoginFile As String, strFtpFile As String
    Dim fNameHandle As Integer
    Dim strName As String
    Dim nPos As Integer
    Dim nLastPos As Integer
    Dim FileName As String
    Dim row_count As Integer
    If Cells(2, 6).Text = "" Then
            MsgBox "请输入文件名称!"
            GoTo errHandle
    End If
    nLastPos = 1
    For i = 1 To 100
        nPos = InStr(nLastPos, ThisWorkbook.FullName, "\", 0)
        If (nPos <= 0) Then Exit For
        nLastPos = nPos + 1
    Next i
    On Error GoTo errHandle
    fHandle = FreeFile
    strFilename = Left(ThisWorkbook.FullName, nLastPos - 1)
     FileName = Left(Cells(2, 6).Text, 19)
     strFilename = strFilename & FileName
'    strFilename = strFilename & "UDS" & FileName & "D" & Right(Cells(7, 2).Text, 6) & ".txt"
     strFilename = strFilename & ".txt"
'    If (Left(Cells(3, 2).Text, 1) = "1") Then
'        strFilename = strFilename & "DLSJ.TXT"
'
'    Else
'        strFilename = strFilename & "DKSJ.TXT"
'    End If
    Open strFilename For Output As #fHandle
'    Print #fHandle, "总笔数:" & Cells(2, 2).Text; "  总金额:" & Cells(1, 2).Text
'    Print #fHandle, Cells(2, 2).Text & "|" & Round(Cells(1, 2).Text, 2)
    row_count = 1
    For nRow = 5 To 30000
        If Cells(nRow, 1).Text = "" Then Exit For
        If Cells(nRow, 4).Text = "" Then
            MsgBox "第" & nRow & "行的 账号 没有输入"
            GoTo errHandle
        End If
        If Cells(nRow, 6).Text = "" Then
            MsgBox "第" & nRow & "行的 金额 没有输入"
            GoTo errHandle
        End If
        strLine = ""
        For nCol = 1 To 5
            strLine = strLine & Cells(nRow, nCol).Text & "|"
        Next nCol
        strLine = row_count & "|" & strLine & Round(Cells(nRow, 6).Text, 2)
        row_count = row_count + 1
        Print #fHandle, strLine
    Next nRow
    MsgBox "生成批量文件完成，文件名为：【" & strFilename & "】"
errHandle:
    If Err.Number <> 0 Then
        MsgBox Err.Description
        Err.Clear
    End If
    Close #fHandle
End Sub

附上Excel：下载 备用地址：MEGA