我已经完成了我的VBA,我正在尝试运行它。当我进入并从代码窗口按F5时,它会运行,但是当我尝试使用实际工作簿中的按钮时,我得到了#34;无法运行宏。宏可能在此工作簿中不可用,或者可能禁用所有宏。"
'Activating Sheet2 in EMM_Template
Sheets("Sheet2").Activate
'Deleting Column E (Prod RICC)
Sheets("Sheet2").Columns(5).EntireColumn.Delete
'Deleting Row 3 (Title Row)
Sheets("Sheet2").Rows(3).EntireRow.Delete
'Selecting Range
Sheets("Sheet2").Range("A3").CurrentRegion.Select
'Changing Font To Calibri 10
With Sheets("Sheet2").Range("A3").CurrentRegion
With .Font
.Name = "Calibri"
.Size = 10
End With
End With
With Sheets("Sheet2")
For Lrow = 1 To ActiveSheet.UsedRange.Rows.Count
With .Cells(Lrow, "M")
If Not IsError(.Value) Then
If .Value = "FUTURE" Then
.EntireRow.Delete
End If
End If
End With
Next Lrow
End With
'Copying from Sheet2
'Activating/Pasting EMM_ETF
Sheets("Sheet2").Range("A3").CurrentRegion.Copy
Sheets("EMM ETF").Activate
Sheets("EMM ETF").Range("A3").Select
Sheets("EMM ETF").Rows("3:3").Insert shift:=xlDown
'Format Data
Sheets("EMM ETF").Range("A3").CurrentRegion.Select
Range("A3").CurrentRegion.Rows.RowHeight = 12.75
Range("A3").CurrentRegion.Columns.ColumnWidth = 12
Rows("1:1").EntireRow.AutoFit
Rows("2:2").EntireRow.AutoFit
With Sheets("EMM ETF").Rows("2:2").EntireRow
With .Font
.Size = 10
End With
End With
'Deleting 0's from Col FGH
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Trim((Cells(i, 13).Value)) = "CURNCY" Then
Cells(i, 6).Delete shift:=xlToLeft
Cells(i, 6).Delete shift:=xlToLeft
Cells(i, 6).Delete shift:=xlToLeft
End If
Next i
'Deleting 0's from Col IJK
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Trim((Cells(i, 13).Value)) = "STOCK" Then
Cells(i, 9).Delete shift:=xlToLeft
Cells(i, 9).Delete shift:=xlToLeft
Cells(i, 9).Delete shift:=xlToLeft
End If
Next i
'Insert Column to for Action Autofill
Sheets("EMM ETF").Range(Range("J3:L3"), Range("J3:L3").End(xlDown)).Select
Sheets("EMM ETF").Range(Range("J3:L3"), Range("J3:L3").End(xlDown)).Cut
Sheets("EMM ETF").Range("K3").Select
ActiveSheet.Paste
'Match Action Rights to Last Comment
Dim Rng As Range, x As Range
With ActiveSheet
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "No Action", 1) > 0 Then
x.Offset(0, 1).Value = "No Action"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Rights", 1) > 0 Then
x.Offset(0, 1).Value = "Rights"
End If
Next
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Warrant", 1) > 0 Then
x.Offset(0, 1).Value = "Warrant"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Pinksheet", 1) > 0 Then
x.Offset(0, 1).Value = "Pinksheet"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Desk", 1) > 0 Then
x.Offset(0, 1).Value = "Desk to adjust"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Asset", 1) > 0 Then
x.Offset(0, 1).Value = "Asset Servicing"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Journal", 1) > 0 Then
x.Offset(0, 1).Value = "MO Journal"
End If
Next x
End With
'Detect/Cut/Insert/CCY
Dim CorrectPosition As Integer
CorrectPosition = getCorrectPosition("Ccy")
Call MoveRows("K", "CURNCY", CorrectPosition)
'Detect/Cut/Insert/Foreign
CorrectPosition = getCorrectPosition("Foreign")
Call MoveRows("A", "FRGN3", CorrectPosition)
'Changing Font To Calibri 10
With Sheets("EMM ETF").Range("A3").CurrentRegion
With .Font
.Name = "Calibri"
.Size = 10
End With
End With
'Final Sort
End Sub
Function getCorrectPosition(StringToLookFor As String) As Integer
Dim i As Integer
For i = 3 To ActiveSheet.UsedRange.Rows.Count
If (Cells(i, 1) = StringToLookFor) Then
Exit For
End If
Next
getCorrectPosition = i + 2
End Function
Sub MoveRows(columnName As String, LookupValue As String, positionToPaste As Integer)
With Sheets("EMM ETF")
For Lrow = 2 To ActiveSheet.UsedRange.Rows.Count
With .Cells(Lrow, columnName)
If Not IsError(.Value) Then
If .Value = LookupValue Then
.EntireRow.Cut
Cells(positionToPaste, 1).Select
Selection.Insert shift:=xlDown
Lrow = 1
ElseIf .Value = "" Then
Exit For
End If
End If
End With
Next Lrow
End With
End Sub
答案 0 :(得分:0)
您可能必须将工作簿另存为启用宏的工作簿,然后重新打开它。如果提示启用宏,请单击“确定”。