我正在 Excel 中创建一个宏。
当我需要运行一些 VBA 代码时，我进入了自动化中的特定阶段。
在自动化过程中，我点击开发人员并输入我需要输入的内容。
但是，当我停止录制并尝试从头开始运行宏时，它会在打开开发人员选项卡时停止并且不会完成该过程。
子创建投资组合()'
' 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
Dim I As Long, K 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 + (K Mod I), 1 + Int(K / I)) = xRg.Cells(K + 1)
Next
xOutRg.Range("A1").Resize(I, UBound(xOutArr, 2)) = xOutArr
End Sub
但是此代码已作为模块插入到工作表中，因此我只需打开开发人员选项卡并单击 F5 即可输入一些参数来运行代码。