TXT批量单独VBA制盘参考（1）

EthanHunt

Private Sub CommandButton1_Click() '处理表格全部 ————1

Application.ScreenUpdating = True

Dim EndRow As Single

Dim i&, j&, k&, m$

On Error Resume Next

ThisWorkbook.Sheets(17).Range("G1:I99").Select

Selection.ClearContents

ThisWorkbook.Sheets(17).Range("I1") = ThisWorkbook.Sheets(17).Range("a1")

ThisWorkbook.Sheets(17).Range("I1").Select

ThisWorkbook.Sheets(17).Range("I1").Replace What:=" ", Replacement:=""

ThisWorkbook.Sheets(17).Range("I1").Replace What:="普宁市大坝镇", Replacement:=""

ThisWorkbook.Sheets(17).Range("I1").Replace What:="大坝镇", Replacement:=""

ThisWorkbook.Sheets(17).Range("I1").Replace What:="教师", Replacement:=""

ThisWorkbook.Sheets(17).Range("I1").Replace What:="初级中学", Replacement:="中学"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="学校小学", Replacement:="小学"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="小学学校", Replacement:="小学"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="学校", Replacement:="小学"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="月个*税*", Replacement:="月个人所得税"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="个人*税*", Replacement:="个人所得税"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="个税*", Replacement:="个人所得税"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="职业*", Replacement:="职业年金"

ThisWorkbook.Sheets(17).Range("I1").Replace What:="月社保职业*", Replacement:="职业年金"

ThisWorkbook.Sheets(17).Shapes.Range(Array("TextBox 1")).Select

Selection.Text = ThisWorkbook.Sheets(17).Range("I1").Text

For i = 250 To 1 Step -1

   If ThisWorkbook.Sheets(17).Cells(i, 4).Text Like "0" Or ThisWorkbook.Sheets(17).Cells(i, 4).Text Like "" Then

  ThisWorkbook.Sheets(17).Cells(i, 4).EntireRow.Delete

   End If

Next

For i = 250 To 1 Step -1

      If ThisWorkbook.Sheets(17).Cells(i, 3).Text Like "62*" Or ThisWorkbook.Sheets(17).Cells(i, 3).Text Like "8001000*" Then

      Else

       ThisWorkbook.Sheets(17).Cells(i, 3).EntireRow.Delete

       End If

   Next

Columns("D:D").NumberFormatLocal = "G/通用格式"

Columns("A:D").Select

Selection.Replace What:=" ", Replacement:=""

j = Application.WorksheetFunction.Count(ThisWorkbook.Sheets(17).[D:D])

For k = 1 To j

Cells(k, 1) = k

Next k

m = Application.WorksheetFunction.Sum(ThisWorkbook.Sheets(17).[D:D])

ThisWorkbook.Sheets(17).Cells(8, 7) = j

ThisWorkbook.Sheets(17).Cells(8, 8) = m

ThisWorkbook.Sheets(17).Cells(7, 7) = "人数"

ThisWorkbook.Sheets(17).Cells(7, 8) = "金额"

ThisWorkbook.Sheets(17).Range("I1").Select

Selection.ClearContents

End Sub       

Private Sub CommandButton2_Click() '通过生成TXT ———————— 2

    Dim lngRow          As Long

    Dim lngCol          As Long

    Dim strContent      As String

    Dim objSheet        As Worksheet

    Dim l&, m$

    On Error Resume Next

'MkDir ThisWorkbook.Path & "\导出TXT"

'n = Split(ActiveWorkbook.Name, ".")(0)

l = ThisWorkbook.Sheets(17).Shapes.Range(Array("TextBox 1")).TextFrame.Characters.Caption

Open ThisWorkbook.Path & "\4TXT\" & l & ".txt" For Output As #1

m = Application.WorksheetFunction.Count(ThisWorkbook.Sheets(17).[A:A])

    For lngRow = 1 To m - 1

        strContent = ThisWorkbook.Sheets(17).Cells(lngRow, 1).Text & "|" & ThisWorkbook.Sheets(17).Cells(lngRow, 2).Text & "|" & ThisWorkbook.Sheets(17).Cells(lngRow, 3).Text & "|" & ThisWorkbook.Sheets(17).Cells(lngRow, 4).Text

        strContent = strContent & vbCrLf

    Print #1, strContent;

     Next

    strContent = ThisWorkbook.Sheets(17).Cells(m, 1).Text & "|" & ThisWorkbook.Sheets(17).Cells(m, 2).Text & "|" & ThisWorkbook.Sheets(17).Cells(m, 3).Text & "|" & ThisWorkbook.Sheets(17).Cells(m, 4).Text

    Print #1, strContent;

    Close #1

End Sub       

Private Sub CommandButton3_Click() '复制数据——————3

ThisWorkbook.Sheets(17).Range("G8:H8").Select

Selection.Copy

End Sub