マクロを選択した範囲で操作する

Question

私は完璧なマクロを作成しましたが、もちろんすべてのマクロは標準です - 記録された正確な行でのみ動作します。どの行でも動作する必要があります。さまざまなカスタムコーディングを試みました。私はそれが同じエリアの上に同じ数式と書式設定以外何もすることはできません。常に行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 

誰にでもアイデアはありますか？あまりにも先にありがとうございます...

Answer 1

私はあなたのコードを作成しました。あなたはどんな行でも尋ねることができます。実行したい行の任意のセルでクリックするだけです。私はこのコードをお勧めしません、それはむしろ厄介で重複したコードがたくさんありますが、うまくいきます。私はそれが何をしているのかを学んで、余分なコードを取り除くつもりです。

セルを選択して式を設定するのではなく、コードの処理速度を遅くするため、ほぼすべての選択ステートメントを削除しました。

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 

Answer 2

この置き換え：それはあなたの質問が何であるか本当にないように私はすべての書式コードに取得することはありません

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 

と

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 

を - ポイントを使うということです変数を使用して.Rowプロパティを取得し、それをコード内で使用することができます。