【VBA】按条件生成txt文件，复杂问题简单化（标准化）

 总表数据

 

各种情况

 

 

 

 预处理

对各种条件的数据分配成独立的数组，然后输出到标准模块 

Private Sub crIptxt_Click()
    Dim err, frr, eUb%, lRow%
    Dim qsbbn%, qsdun%, sgbbn%, sgdun%
    Dim parts_du, parts_bb, parts_du_sg, parts_bb_sg
    parts_du = UserForm2.qs_du.Text
    parts_bb = UserForm2.qs_bb.Text

    With Worksheets("网元数据")
        .Select
        lRow = .[D65536].End(xlUp).Row
        err = .Range("D2:G" & lRow)
        eUb = lRow - 1
        '------------------------------删除
        If UserForm2.del.Value = True Then
            frr = Application.WorksheetFunction.Transpose(.Range("D2:D" & lRow))
            Call crIptext(frr, parts_du, "ip")
            Call crSummary("删除")
        '------------------------------新增1
        ElseIf UserForm2.batch1.Value = True Then
            Dim bb_err(), du_err()
            qsbbn = 1: qsdun = 1
            For i = 1 To eUb
                If err(i, 4) = "BB" Then
                    ReDim Preserve bb_err(1 To qsbbn)
                    bb_err(qsbbn) = err(i, 1)
                    qsbbn = qsbbn + 1
                ElseIf err(i, 4) = "DU" Then
                    ReDim Preserve du_err(1 To qsdun)
                    du_err(qsdun) = err(i, 1)
                    qsdun = qsdun + 1
                End If
            Next
            Call crIptext(du_err, parts_du, "du_ip")
            Call crIptext(bb_err, parts_bb, "bb_ip")
            Call crSummary("新增第一组")
        '------------------------------新增23
        ElseIf UserForm2.batch2.Value = True Or UserForm2.batch3.Value = True Then
        '2地市4类型
            Dim qs_du_err(), qs_bb_err(), sg_du_err(), sg_bb_err()
            qsbbn = 1: qsdun = 1: sgbbn = 1: sgdun = 1
            For i = 1 To eUb
                If err(i, 2) <> "韶关" And err(i, 4) = "BB" Then
                    ReDim Preserve qs_bb_err(1 To qsbbn)
                    qs_bb_err(qsbbn) = err(i, 1)
                    qsbbn = qsbbn + 1
                ElseIf err(i, 2) <> "韶关" And err(i, 4) = "DU" Then
                    ReDim Preserve qs_du_err(1 To qsdun)
                    qs_du_err(qsdun) = err(i, 1)
                    qsdun = qsdun + 1
                ElseIf err(i, 2) = "韶关" And err(i, 4) = "BB" Then
                    ReDim Preserve sg_bb_err(1 To sgbbn)
                    sg_bb_err(sgbbn) = err(i, 1)
                    sgbbn = sgbbn + 1
                ElseIf err(i, 2) = "韶关" And err(i, 4) = "DU" Then
                    ReDim Preserve sg_du_err(1 To sgdun)
                    sg_du_err(sgdun) = err(i, 1)
                    sgdun = sgdun + 1
                End If
            Next
            parts_du_sg = UserForm2.sg_du.Text
            parts_bb_sg = UserForm2.sg_bb.Text
            Call crIptext(qs_du_err, parts_du, "du_ip")
            Call crIptext(qs_bb_err, parts_bb, "bb_ip")
            Call crIptext(sg_du_err, parts_du_sg, "du_ip_SG")
            Call crIptext(sg_bb_err, parts_bb_sg, "bb_ip_SG")
            If UserForm2.batch2.Value = True Then
                Call crSummary("新增第二组")
            ElseIf UserForm2.batch3.Value = True Then
                Call crSummary("新增第三组")
            End If
            
        End If
     End With
     MsgBox "己生成IP文件"
End Sub

 标准模块（子程序）

预处理后统一输出到本模块 

Sub crIptext(err, parts, fname)
    
    Dim f$, eUb%, quotient%, n%
    eUb = UBound(err)
    quotient = Int(eUb / parts) '商
    n = 1
    For i = 1 To eUb
        '每份文件的开头处生成文件，11个生成2份，i为1，5时生成
        If i = (n - 1) * quotient + 1 Then 
            f = ThisWorkbook.Path & "\" & fname & n & ".txt"
            Open f For Output As #1
        End If
        'i为文件最后一行，则在后面加;，不生成空行，11个生成2份，第一份i为5，第二份i为11
        If (n <> parts And i = n * quotient) Or i = eUb Then
            Print #1, err(i);
            Close #1
            n = n + 1
        Else
            Print #1, err(i)
        End If
    Next
End Sub