在excel中创建一个在我运行VBA代码的阶段暂停的宏


0

我在excel中创建一个宏。

当我需要运行一些VBA代码时,我进入自动化的特定阶段。

在自动化过程中,我点击Developer并输入我需要输入的内容。

但是,当我停止录制并尝试从头开始运行宏时,它会在打开开发人员选项卡时停止,并且不会完成该过程。

Sub CreatePortfolio()'

' CreatePortfolio Macro
'

'
    Range("A2:H132").Select
    ActiveWindow.SmallScroll Down:=-144
    Range("D1").Select
    ActiveWindow.SmallScroll Down:=-6
    ActiveCell.FormulaR1C1 = "Blank"
    Range("H1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 11
        .ColorIndex = 11
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Name"
    Cells.Select
    ActiveWorkbook.Worksheets("INPUT_DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("INPUT_DATA").Sort.SortFields.Add2 Key:=Range( _
        "B1:B132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("INPUT_DATA").Sort.SortFields.Add2 Key:=Range( _
        "C1:C132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("INPUT_DATA").Sort
        .SetRange Range("A1:H132")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("H14").Select
    ActiveWindow.SmallScroll Down:=-15
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveWindow.SmallScroll Down:=126
    Range("A133:H133").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-168
    Range("A1").Select
    ActiveSheet.Paste
    Range("I2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=COUNTIF(R2C8:R20000C8,RC[-8])"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I133")
    Range("I2:I133").Select
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]>0,1,0)"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J133")
    Range("J2:J133").Select
    Range("I1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 11
        .ColorIndex = 11
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "IF1"
    Range("J1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 11
        .ColorIndex = 11
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "IF2"
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$J$133").AutoFilter Field:=10, Criteria1:="0"
    Range("A1:J133").Select
    Selection.Copy
    Sheets("SORT1").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").EntireColumn.AutoFit
    Range("K5").Select
    Columns("G:G").EntireColumn.AutoFit
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("L:L").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$L$1:$L$44").RemoveDuplicates Columns:=1, Header:=xlNo
    Columns("L:L").EntireColumn.AutoFit
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",0,1)"
    Range("M1").Select
    Selection.AutoFill Destination:=Range("M1:M4")
    Range("M1:M4").Select
    Range("M21").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)-1"
    Range("L21").Select
    ActiveCell.FormulaR1C1 = "Magic Number"

在这里,当我试图点击开发者并运行VBA代码时

    Range("N21").Select
        ActiveWindow.SmallScroll Down:=-24
        Range("O2").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=RC[-3]"
        Range("O2").Select
        Selection.AutoFill Destination:=Range("O2:O20"), Type:=xlFillDefault
        Range("O2:O20").Select
        ActiveWindow.SmallScroll Down:=-15
        Selection.ClearContents
        Range("O2").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",RC[-3])"
        Range("O2").Select
        Selection.AutoFill Destination:=Range("O2:O20"), Type:=xlFillDefault
        Range("O2:O20").Select
        ActiveWindow.SmallScroll Down:=-27
        Range("P2").Select
        Columns("P:P").EntireColumn.AutoFit
        Range("P2").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-11])"
        Range("P2").Select
        Selection.AutoFill Destination:=Range("P2:P19"), Type:=xlFillDefault
        Range("P2:P19").Select
        ActiveWindow.SmallScroll Down:=-33
        Range("O8:Y10").Select
        ActiveWindow.ScrollColumn = 16
        ActiveWindow.ScrollColumn = 15
        ActiveWindow.ScrollColumn = 12
        ActiveWindow.ScrollColumn = 9
        ActiveWindow.ScrollColumn = 7
        ActiveWindow.ScrollColumn = 6
        ActiveWindow.ScrollColumn = 5
        ActiveWindow.ScrollColumn = 4
        ActiveWindow.ScrollColumn = 3
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.ScrollColumn = 2
        ActiveWindow.ScrollColumn = 3
        ActiveWindow.ScrollColumn = 4
        ActiveWindow.ScrollColumn = 5
        ActiveWindow.ScrollColumn = 6
        ActiveWindow.ScrollColumn = 7
        ActiveWindow.ScrollColumn = 8
        ActiveWindow.ScrollColumn = 9
        ActiveWindow.SmallScroll Down:=3
        Range("O21").Select
        ActiveCell.FormulaR1C1 = "Returns "
        Range("O22").Select
        Sheets("CODE FOR VBA").Select
        ActiveWindow.SmallScroll Down:=-57
        Range("A1:A35").Select
        Selection.Copy
        Sheets("SORT1").Select
        Application.CutCopyMode = False
    End Sub
    Sub Macro2()
    '
    ' Macro2 Macro
    '

    '
        Cells.Select
        ActiveWorkbook.Worksheets("INPUT_DATA").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("INPUT_DATA").Sort.SortFields.Add2 Key:=Range( _
            "B2:B133"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        ActiveWorkbook.Worksheets("INPUT_DATA").Sort.SortFields.Add2 Key:=Range( _
            "C2:C133"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("INPUT_DATA").Sort
            .SetRange Range("A1:F133")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Range("H6").Select
        Columns("A:A").EntireColumn.AutoFit
        Range("G2").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",RC[-6],"""")"
        Range("G2").Select
        Selection.AutoFill Destination:=Range("G2:G132")
        Range("G2:G132").Select
        Columns("G:G").EntireColumn.AutoFit
        Range("G1").Select
        ActiveCell.FormulaR1C1 = "Missing Data"
        Range("H2").Select
        ActiveCell.FormulaR1C1 = "=COUNTIF(R2C8:R250C8,RC[-7])"
        Range("H2").Select
        ActiveCell.FormulaR1C1 = "=COUNTIF(R2C7:R2500C7,RC[-7])"
        Range("H2").Select
        Selection.AutoFill Destination:=Range("H2:H132")
        Range("H2:H132").Select
        Range("H1").Select
        ActiveCell.FormulaR1C1 = "IF1"
        Range("I1").Select
        ActiveCell.FormulaR1C1 = "IF2"
        Range("I2").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-1]>0,1,0)"
        Range("I2").Select
        Selection.AutoFill Destination:=Range("I2:I132")
        Range("I2:I132").Select
        Rows("1:1").Select
        Range("B1").Activate
        Selection.AutoFilter
        ActiveWindow.ScrollColumn = 2
        ActiveSheet.Range("$A$1:$I$132").AutoFilter Field:=9, Criteria1:="1"
        ActiveSheet.Range("$A$1:$I$132").AutoFilter Field:=9, Criteria1:="0"
        ActiveWindow.SmallScroll Down:=-15
        Cells.Select
        Selection.Copy
        Sheets("SORT1").Select
        Cells.Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Columns("G:I").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
        Columns("F:F").EntireColumn.AutoFit
        Columns("A:A").Select
        Selection.Copy
        Columns("I:I").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveSheet.Range("$I$1:$I$43").RemoveDuplicates Columns:=1, Header:=xlNo
        Range("J1").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",1)"
        Range("J1").Select
        Selection.AutoFill Destination:=Range("J1:J4")
        Range("J1:J4").Select
        ActiveWindow.SmallScroll Down:=12
        Range("J50").Select
        ActiveCell.FormulaR1C1 = "=SUM(R[-49]C:R[-1]C)-1"
        Range("I50").Select
        ActiveCell.FormulaR1C1 = "Magic Number"
        Range("I51").Select
        ActiveWindow.SmallScroll Down:=-30
        Range("L1").Select
        ActiveWindow.SmallScroll Down:=-3
        ActiveCell.FormulaR1C1 = "Market Value"
        Range("L2").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-3]="""","""",RC[-8])"
        Range("L2").Select
        Selection.AutoFill Destination:=Range("L2:L49"), Type:=xlFillDefault
        Range("L2:L49").Select
        ActiveWindow.SmallScroll Down:=-33
        Range("L5").Select
        ActiveWindow.SmallScroll Down:=24
        Range("L51").Select
        ActiveCell.FormulaR1C1 = "Returns"
        Range("M52").Select
        ActiveWindow.SmallScroll Down:=-27
        ActiveCell.FormulaR1C1 = ""
        Range("M52").Select
        ActiveWindow.SmallScroll Down:=-30
        Range("M2").Select
        ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-1]*(1+R[50]C))"
        Range("M2").Select
        Selection.AutoFill Destination:=Range("M2:M34"), Type:=xlFillDefault
        Range("M2:M34").Select
        Selection.AutoFill Destination:=Range("M2:M44"), Type:=xlFillDefault
        Range("M2:M44").Select
        Selection.AutoFill Destination:=Range("M2:X44"), Type:=xlFillDefault
        Range("M2:X44").Select
        ActiveWindow.SmallScroll Down:=0
        Selection.AutoFill Destination:=Range("M2:Z44"), Type:=xlFillDefault
        Range("M2:Z44").Select
        ActiveWindow.SmallScroll Down:=-21
        Selection.AutoFill Destination:=Range("M2:AA44"), Type:=xlFillDefault
        Range("M2:AA44").Select
        ActiveWindow.SmallScroll Down:=-6
        Range("AA2:AA44").Select
        Selection.ClearContents
        Range("M2:Z44").Select
        ActiveWindow.SmallScroll Down:=9
        Range("L56").Select
        ActiveCell.FormulaR1C1 = "Equal Weighted "
        Range("M56").Select
        ActiveCell.FormulaR1C1 = "=IF(R[-4]C="""","""",AVERAGE(R[-4]C:R[-2]C))"
        Range("M56").Select
        Selection.AutoFill Destination:=Range("M56:Z56"), Type:=xlFillDefault
        Range("M56:Z56").Select
        Range("L57").Select
        ActiveCell.FormulaR1C1 = "Value Weighted"
        Range("M57").Select
        ActiveCell.FormulaR1C1 = _
            "=SUMPRODUCT(R[-55]C[-1]:R[-53]C[-1],R[-5]C:R[-3]C)/SUM(R[-55]C[-1]:R[-53]C[-1])"
        Range("M57").Select
        Selection.AutoFill Destination:=Range("M57:Z57"), Type:=xlFillDefault
        Range("M57:Z57").Select
        Range("R46").Select
        ActiveWindow.SmallScroll Down:=9
        Range("L56:Z57").Select
        Selection.Copy
        Sheets("SORT2").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A1").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "Returns"
        Range("A2").Select
    End Sub

The VBA code that I run is, 

    Sub SplitIntoCellsPerColumn()
    'updatebyExtendoffice 20160225
        Dim xRg As Range
        Dim xOutRg As Range
        Dim xCell As Range
        Dim xTxt As String
        Dim xOutArr As Variant
        DimAs Long,As Long
        On Error Resume Next
        xTxt = ActiveWindow.RangeSelection.Address
    Sel:
        Set xRg = Nothing
        Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
        If xRg Is Nothing Then Exit Sub
        If xRg.Areas.Count > 1 Then
            MsgBox "does not support multiple selections, please select again", vbInformation, "Kutools for Excel"
            GoTo Sel
        End If
        If xRg.Columns.Count > 1 Then
            MsgBox "does not support multiple columns,please select again", vbInformation, "Kutools for Excel"
            GoTo Sel
        End If
        Set xOutRg = Application.InputBox("please select a cell to put the result:", "Kutools for Excel", , , , , , 8)
        If xOutRg Is Nothing Then Exit Sub
        I = Application.InputBox("the number of cell per column:", "Kutools for Excel", , , , , , 1)
        If I < 1 Then
            MsgBox "incorrect enter", vbInformation, "Kutools for Excel"
            Exit Sub
        End If
        ReDim xOutArr(1 To I, 1 To Int(xRg.Rows.Count / I) + 1)
        For K = 0 To xRg.Rows.Count - 1
          xOutArr(1 + (Mod I), 1 + Int(K / I)) = xRg.Cells(K + 1)
        Next
        xOutRg.Range("A1").Resize(I, UBound(xOutArr, 2)) = xOutArr
    End Sub

但是这段代码已作为模块插入到工作表中,所以我只需打开开发人员选项卡,然后单击F5输入一些参数即可运行代码。


它希望您再次在开发人员选项卡中输入值。要解决此问题,请编辑宏并更改其中的值,编辑其生成的开发人员选项卡代码。
LPChip

我有点迷失了
user22485

我已经添加了宏代码,如果你能提供任何见解
user22485

@ZarinaAkhtar,你可以更好地编辑你的问题并粘贴你记录的VBA代码,并在你要运行宏的位置标记舞台或行。写下目标。☺
Rajesh S

@ZarinaAkhtar,这是一个更好的写一个目标,你正在通过宏尝试什么?
Rajesh S
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.