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

3
1541

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
 
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:点此下载

3 评论

    • @CrazyM
      工资格式一样的,不过我们姓名的格式用Excel的话要用常规,不能文本,文本的话导入失败。之前我发的一个单位的,每个月人数,工资都变动,200多号人,之前还是手工一笔一笔的上啊,又一次少了0.03,我找了整整半个小时。 :cry:

      批量开卡我们不用核查,直接建好格式,提交,把卡拿出来就行。

发表回复

Please enter your comment!
Please enter your name here