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

3
513

汗,相当的纠结啊,科技部(还不如叫机房那边)的力量不够,发个成百户的工资,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

上一篇Excel所在单元格行列自动加背景色突显
下一篇PHP生成WordPress测试数据

3 条留言

    • @CrazyM
      工资格式一样的,不过我们姓名的格式用Excel的话要用常规,不能文本,文本的话导入失败。之前我发的一个单位的,每个月人数,工资都变动,200多号人,之前还是手工一笔一笔的上啊,又一次少了0.03,我找了整整半个小时。 😥
      批量开卡我们不用核查,直接建好格式,提交,把卡拿出来就行。

  1. 我们发工资的格式就四列,序号、姓名、金额、身份证号,也是文本格式,好像没这么麻烦

留言

留言不能为空
怎么称呼您?

验证码 *