Erhalte ein Makro, um im ausgewählten Bereich zu arbeiten

Question

Ich habe das perfekte Makro erstellt, aber natürlich, wie alle Makros, ist es Standard - funktioniert nur in den exakten Reihen, in denen es aufgenommen wurde. Ich brauche es in jeder Zeile, die ich hervorhebe und ich ' Ich habe eine Vielzahl von benutzerdefinierten Codierung versucht. Ich kann nichts anderes erreichen als die gleiche Formel und Formatierung oben auf demselben Gebiet. Immer Zeile 5. Dies ist der Code ...

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 

Hat jemand irgendwelche Ideen? Vielen Dank im Voraus ...

Answer 1

Ich habe ein schnelles Bit Ihres Codes erstellt, um das zu tun, was Sie in jeder Zeile fragen. Sie müssen nur in eine Zelle der Zeile geklickt werden, in der sie ausgeführt werden soll. Ich würde diesen Code nicht empfehlen, da er eher schlampig ist und viel doppelten Code hat, aber es funktioniert. Ich würde daran arbeiten, zu lernen, was es tut, und jeden zusätzlichen Code loswerden.

Ich habe auch fast alle Select-Anweisungen losgeworden, weil sie Ihren Code verlangsamen, anstatt eine Zelle auszuwählen und dann die Formel zu setzen, fügen Sie sie einfach in eine Zeile ein, wie ich es mit Ihrem Code gemacht habe.

Viel Spaß beim Lernen VBA, es macht Spaß und Sie haben viele sachkundige Leute auf dieser Seite für Sie Hilfe zu bekommen.

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

das Ersetzen:

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 

mit

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 

Ich werde nicht in alle Formatierungscode bekommen, da es nicht wirklich ist, was Ihre Frage ist - der Punkt ist, dass Sie kann eine Variable verwenden, um die Eigenschaft .Row zu erhalten und diese in Ihrem Code zu verwenden.