讓宏在選定的範圍內運行

我創建了一個完美的宏，但是當然所有的宏都是標準的 - 只在它記錄的確切行中工作。我需要它在任何行中工作，我嘗試了各種自定義編碼。我不能讓它做任何事情，除了在同一區域上面使用相同的公式和格式。總是第5行。這是代碼...讓宏在選定的範圍內運行

Sub OrschelnMacro() 
' 
' OrschelnMacro Macro 
' 
' Keyboard Shortcut: Ctrl+p 
' 
    Rows("5:5").Select 
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Range("E5").Select 
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" 
    Range("G5").Select 
    ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" 
    Range("H5").Select 
    ActiveCell.FormulaR1C1 = "1" 
    Range("F5").Select 
    ActiveCell.FormulaR1C1 = "1 of 1" 
    Rows("5:5").Select 
    Selection.RowHeight = 75 
    With Selection.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .Color = 65535 
     .TintAndShade = 0 
     .PatternTintAndShade = 0 
    End With 
    With Selection.Font 
     .Name = "Calibri" 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ColorIndex = xlAutomatic 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMinor 
    End With 
    With Selection.Font 
     .Name = "Calibri" 
     .Size = 26 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ColorIndex = xlAutomatic 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMinor 
    End With 
    Selection.Font.Bold = True 
    Range("H5").Select 
    With Selection.Font 
     .Name = "Calibri" 
     .Size = 72 
     .Strikethrough = False 
     .Superscript = False 
     .Subscript = False 
     .OutlineFont = False 
     .Shadow = False 
     .Underline = xlUnderlineStyleNone 
     .ColorIndex = xlAutomatic 
     .TintAndShade = 0 
     .ThemeFont = xlThemeFontMinor 
    End With 
    With Selection 
     .HorizontalAlignment = xlGeneral 
     .VerticalAlignment = xlTop 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("E5:G5").Select 
    With Selection 
     .VerticalAlignment = xlTop 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("H5").Select 
    With Selection 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlTop 
     .WrapText = False 
     .Orientation = 0 
     .AddIndent = False 
     .IndentLevel = 0 
     .ShrinkToFit = False 
     .ReadingOrder = xlContext 
     .MergeCells = False 
    End With 
    Range("A5:H5").Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlMedium 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlMedium 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlMedium 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlContinuous 
     .ColorIndex = 0 
     .TintAndShade = 0 
     .Weight = xlMedium 
    End With 
    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Range("K7").Select 
End Sub

有沒有人有任何想法？非常感謝您提前...

來源

2016-04-27 Courtney Cascante

所以不要繼續做'行（「5：5」）。選擇'？ – findwindow

它總是與正在使用的列相同嗎？你也可以在運行時選擇整行，或者只是選擇特定的單元格？ – Histerical

我創建了一小段代碼來完成您在任何行上所要求的操作，只需在要運行的行的任何單元格中單擊即可。我不會推薦這個代碼，因爲它很瑣碎，並且有很多重複的代碼，但是它可以工作。我會努力學習它在做什麼並擺脫任何額外的代碼。

我也擺脫了幾乎所有的select語句，因爲他們放慢你的代碼，而不是選擇一個單元格，然後設置公式，你只要把在同一行，因爲我與你的代碼一樣。

祝你好運VBA學習，這很有趣，你有很多有知識的人在這個網站上獲得幫助。

Sub OrschelnMacro() 
' 
' OrschelnMacro Macro 
' 
' Keyboard Shortcut: Ctrl+p 
' 
curRow = Selection.Row 
Selection.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Range("E" & curRow).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" 
Range("G" & curRow).FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" 
Range("H" & curRow).FormulaR1C1 = "1" 
Range("F" & curRow).FormulaR1C1 = "1 of 1" 
Rows(curRow).RowHeight = 75 
With Rows(curRow).Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .Color = 65535 
    .TintAndShade = 0 
    .PatternTintAndShade = 0 
End With 
With Rows(curRow).Font 
    .Name = "Calibri" 
    .Size = 26 
    .Bold = True 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .ColorIndex = xlAutomatic 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontMinor 
End With 
Range("H" & curRow).Select 
With Range("H" & curRow).Font 
    .Name = "Calibri" 
    .Size = 72 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .Underline = xlUnderlineStyleNone 
    .ColorIndex = xlAutomatic 
    .TintAndShade = 0 
    .ThemeFont = xlThemeFontMinor 
End With 
With Range("H" & curRow) 
    .HorizontalAlignment = xlGeneral 
    .VerticalAlignment = xlTop 
    .WrapText = False 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .ReadingOrder = xlContext 
    .MergeCells = False 
End With 
With Range("E" & curRow & ":G" & curRow) 
    .VerticalAlignment = xlTop 
    .WrapText = False 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .ReadingOrder = xlContext 
    .MergeCells = False 
End With 
With Range("H" & curRow) 
    .HorizontalAlignment = xlCenter 
    .VerticalAlignment = xlTop 
    .WrapText = False 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .ReadingOrder = xlContext 
    .MergeCells = False 
End With 
Range("A" & curRow & ":H" & curRow).Borders(xlDiagonalDown).LineStyle = xlNone 
Range("A" & curRow & ":H" & curRow).Borders(xlDiagonalUp).LineStyle = xlNone 
With Range("A" & curRow & ":H" & curRow).Borders(xlEdgeLeft) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlMedium 
End With 
With Range("A" & curRow & ":H" & curRow).Borders(xlEdgeTop) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlMedium 
End With 
With Range("A" & curRow & ":H" & curRow).Borders(xlEdgeBottom) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlMedium 
End With 
With Range("A" & curRow & ":H" & curRow).Borders(xlEdgeRight) 
    .LineStyle = xlContinuous 
    .ColorIndex = 0 
    .TintAndShade = 0 
    .Weight = xlMedium 
End With 
Range("A" & curRow & ":H" & curRow).Borders(xlInsideVertical).LineStyle = xlNone 
Range("A" & curRow & ":H" & curRow).Borders(xlInsideHorizontal).LineStyle = xlNone 
End Sub

來源

2016-04-27 21:47:14 Histerical

笑給予好評的'我不會推薦這code' – findwindow

替換此：

Rows("5:5").Select 
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Range("E5").Select 
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" 
Range("G5").Select 
ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" 
Range("H5").Select 
ActiveCell.FormulaR1C1 = "1" 
Range("F5").Select 
ActiveCell.FormulaR1C1 = "1 of 1" 
Rows("5:5").Select 
Selection.RowHeight = 75

與

Dim myRow As Long  

myRow = Selection.Row 

Rows(myRow).Insert 
Range("E" & myRow & ":H" & myRow).FormulaR1C1 = _ 
    Array("=SUM(R[-2]C:R[-1]C)", "1 of 1", "=SUM(R[-2]C:R[-1]C)", "1") 

Rows(myRow).RowHeight = 75

我不會進入所有的格式代碼，因爲它不是真正的你的問題是什麼 - 的一點是，你可以使用一個變量來獲得.Row屬性並在你的代碼中使用它。

來源

2016-04-27 22:34:55

逸陣...... – findwindow

讓宏在選定的範圍內運行

回答

相關問題