Question

我在VBA中创建了这个sub，它将工作表的内容复制到新工作表，然后格式化并将其保存为.csv。但是当我调试它时，sub会单独跳转到另一个模块中的函数并启动无限循环。根据命令的组织，它会在此功能之前或之后跳转，但始终跳过。在当前的子目录中跳跃着＆＃34; .move＆＃34;命令。

我还没有找到解决方案，因为民意调查总是会返回如下内容：＆＃34;如何做一个sub自动调用函数？＆＃34;但这正是我没有意愿发生的事情。

那是我的Sub

Sub TCzor()
'

Dim MData, MStr
Dim ultimalinha As Integer
Dim valorA As String
Dim valorB As String
Dim valorC As String
Dim valorD As String
Dim sUserName As String

MData = Date
MStr = Format(MData, "ddmm")
sUserName = Environ$("username")
'

    Windows("MultiTrat.xlsm").Activate
    Sheets("MultiTrat").Select

    Sheets.Add After:=ActiveSheet

    ActiveSheet.Name = "TCzor"

    Sheets("MultiTrat").Select


    Range("AX3:BF111").Select

    Application.CutCopyMode = False
    Selection.Copy
    Sheets("TCzor").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$I$109").AutoFilter Field:=1, Criteria1:="="
    Rows("2:2").Select
    Range(Selection, Rows("1000:1000")).Select

    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("G:G").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Range(Selection, Columns("XFD:XFD")).Select
    Selection.Delete Shift:=xlToLeft
    Range("D1").Value = "Valor"
    Columns("D:D").Select
    Selection.NumberFormat = "0.00"

    ultimalinha = Range("A1").End(xlDown).Row

    For linha = 2 To ultimalinha
        If Cells(linha, 3).Value = "C" Then
        Cells(linha, 3).Value = "Créd"
        Else
        Cells(linha, 3).Value = "Déb"
        End If
    Next linha

    For linha = 1 To ultimalinha
        valorA = Cells(linha, 1)
        valorB = Cells(linha, 2)
        valorC = Cells(linha, 3)
        valorD = Cells(linha, 4)
        Cells(linha, 1) = valorA & ";" & valorB & ";" & valorC & ";" & valorD
    Next linha

    Range("B:D").Delete

    Sheets("TCzor").Select
    Sheets("TCzor").Move
    ChDir "C:\Users\" & sUserName & "\Desktop"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\" & sUserName & "\Desktop\TC" & MStr & ".csv", FileFormat:=xlCSV, _
        CreateBackup:=False
    ActiveWindow.Close
    Windows("tczor_jv.xlsm").Activate
End Sub

这是它自己调用的函数

Function GetARN(Myrange As Range) As String
    Dim regex As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String

    strPattern = "[0-9]{23}"

   strInput = Myrange.Value

   With regex
       .Global = True
       .MultiLine = True
       .IgnoreCase = False
       .Pattern = strPattern
   End With

   Set matches = regex.Execute(strInput)

   For Each Match In matches
       GetARN = Match.Value
   Next Match

宏调用函数而不需要（VBA）

0 个答案: