VBA写excel宏

Sub zzz()

'

' zzz 宏

'

'

    'ActiveWorkbook.Names.Add Name:="S941.群众团体", RefersToR1C1:="=Sheet3!R1C6:R1C6"

    'ActiveWorkbook.Names("S941.群众团体").Comment = ""

    'ActiveSheet.Cells(1, 1).Value = "HYTX4"

    For i = 2 To 443

   

        m = ActiveSheet.Cells(i, 4).Value '获取行业投向三级

        j1 = 0

        For j = 2 To 1076

            n = ActiveSheet.Cells(j, 6).Value '获取行业投向四级

           

           

            If Mid(m, 1, 4) = Mid(n, 1, 4) Then

               

                j1 = j1 + 1

            Else

                If j1 <> 0 Then

                    Exit For

                End If

            End If

        Next j

           

             If j1 <> 0 Then

                    j2 = j - j1

                    'If j <> 1076 Then

                        j = j - 1

                    'End If

                    o = "=Sheet3!R" & j2 & "C6:R" & j & "C6"

                    ActiveSheet.Cells(1, 1).Value = m

                    ActiveSheet.Cells(2, 1).Value = n

                    ActiveSheet.Cells(3, 1).Value = o

                    ActiveSheet.Cells(4, 1).Value = j

                    ActiveSheet.Cells(5, 1).Value = j1

                    ActiveWorkbook.Names.Add Name:=m, RefersToR1C1:=o

             End If

       

    Next i

   

End Sub

---------------------------------------------------------------------------------

Sub bbb()

'

' bbb 宏

    j = 0

    For i = 3 To 30

        m = Sheet1.Cells(i, 1).Value '获取机构号

        j = j + 1

        k = i + 1

        n = Sheet1.Cells(k, 1).Value '获取机构号

        If m <> n Then

            Sheets.Add After:=Sheets(Sheets.Count)

           

           

            Worksheets("Sheet1").Activate

            Rows("1:3").Select

            Selection.Copy

            Sheets(Sheets.Count).Activate

            Range("A1").Select

            ActiveSheet.Paste

           

            Worksheets("Sheet1").Activate

            Rows(i - j + 1 & ":" & k - 1).Select

            Selection.Copy

            Sheets(Sheets.Count).Activate

            Range("A3").Select

            ActiveSheet.Paste

            ActiveSheet.Name = m

            j = 0

        End If

    Next i

End Sub

------------------------------------------------------------------------------------------

Sub CTL()

D_TABLE = Trim(ActiveSheet.Cells(1, 5))

FILE_PATH = Trim(ActiveSheet.Cells(2, 14))

If FILE_PATH = "" Then

    FILE_PATH = "E:\vba-test\SP_" + D_TABLE + ".txt"

End If

n = ActiveSheet.UsedRange.Rows.Count

Dim FS2

Set FS2 = CreateObject("SCRIPTING.FILESYSTEMOBJECT")

Set CTL_FILE = FS2.CREATETEXTFILE(FILE_PATH, True)

S_TABLE = Trim(ActiveSheet.Cells(1, 3))

PROC_START = "create or REPLACE procedure " + D_TABLE + "(IN  ETLDATE VARCHAR(8),--业务日期" + vbCrLf + "OUT  O_RETURN NUMERIC--返回值"

PROC_START = PROC_START + vbCrLf + vbTab + "INSERT INTO" + D_TABLE + "(" + vbCrLf + vbTab + vbTab

CTL_FILE.WRITELINE (PROC_START)

For I = 4 To n

    PROC = ""

    D_ZD = Trim(ActiveSheet.Cells(I, 5))

    D_COMMENT = Trim(ActiveSheet.Cells(I, 6))

    If I = n Then

        PROC = vbTab + vbTab + vbTab + vbTab + D_ZD + " --" + D_COMMENT

    Else

        PROC = vbTab + vbTab + vbTab + vbTab + D_ZD + ",--" + D_COMMENT

    End If

    CTL_FILE.WRITELINE (PROC)

   

Next

CTL_FILE.WRITELINE (vbCrLf + ")" + vbCrLf + vbTab + vbTab + "SELECT" + vbCrLf + vbTab + vbTab)

For I = 4 To n

    PROC = ""

    S_ZD = Trim(ActiveSheet.Cells(I, 1))

    S_COMMENT = Trim(ActiveSheet.Cells(I, 2))

    If I = n Then

        PROC = vbTab + vbTab + vbTab + vbTab + S_ZD + ",--" + S_COMMENT

    Else

        PROC = vbTab + vbTab + vbTab + vbTab + S_ZD + ",--" + S_COMMENT

    End If

    CTL_FILE.WRITELINE (PROC)

Next

CTL_FILE.WRITELINE (vbCrLf + vbTab + vbTab + "FROM " + S_TABLE)

CTL_FILE.Close

MsgBox ("文件" + FILE_PATH + " 创建完毕")

End Sub