首页 > 解决方案 > Excel 宏自动化单元格和列编辑

问题描述

您好我正在尝试在电子表格的某个部分自动插入列和移动数据。目前宏是什么

Sub Macro1()
'
' Macro1 Macro
'

'
    Rows("6:9").Select
    Selection.Insert Shift:=xlDown
    Range("F5").Select
    Selection.Cut
    Range("E6").Select
    ActiveSheet.Paste
    Range("G5").Select
    Selection.Cut
    Range("E7").Select
    ActiveSheet.Paste
    Range("H5").Select
    Selection.Cut
    Range("E8").Select
    ActiveSheet.Paste
    Range("I5").Select
    Selection.Cut
    Range("E9").Select
    ActiveSheet.Paste
    Range("A5").Select
    Selection.Copy
    Range("D6:D9").Select
    ActiveSheet.Paste
    Range("C6").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "10000"
    Range("C7").Select
    ActiveCell.FormulaR1C1 = "20000"
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "30000"
    Range("C9").Select
    ActiveCell.FormulaR1C1 = "40000"
    Range("C10").Select
End Sub

如何更改它以便在我再次选择一组新行时动态更新?

标签: excelvba

解决方案


使用以下已编辑的宏,您可以选择要插入的任意数量的行并使用输入框

Option Explicit
Sub Macro1()
Dim newRows As Range, newRowsAddress As String, previousRow As Range
Dim ColumnLetter As String, i As Long, j As Long

On Error Resume Next
Set newRows = Application.InputBox("Select rows to insert", "New Rows", , , , , , 8)
If newRows Is Nothing Then Exit Sub
On Error GoTo 0
Set previousRow = newRows.Offset(-1).Resize(1, Columns.Count)
newRowsAddress = newRows.Address

'    Rows("6:9").Select
'    Selection.Insert Shift:=xlDown
'    Range("F5").Select
'    Selection.Cut
'    Range("E6").Select
'    ActiveSheet.Paste
'    Range("G5").Select
'    Selection.Cut
'    Range("E7").Select
'    ActiveSheet.Paste
'    Range("H5").Select
'    Selection.Cut
'    Range("E8").Select
'    ActiveSheet.Paste
'    Range("I5").Select
'    Selection.Cut
'    Range("E9").Select
'    ActiveSheet.Paste
newRows.Insert Shift:=xlDown
Set newRows = Range(newRowsAddress)
ColumnLetter = Split(Cells(1, 5 + newRows.Rows.Count).Address, "$")(1)
newRows.Columns("E:E").Value = Application.Transpose(previousRow.Columns("F:" & ColumnLetter).Value)

'    Range("A5").Select
'    Selection.Copy
'    Range("D6:D9").Select
'    ActiveSheet.Paste

newRows.Columns("D:D").Value = Application.Transpose(previousRow.Columns("A:A").Value)

'    Range("C6").Select
'    Application.CutCopyMode = False
'    ActiveCell.FormulaR1C1 = "10000"
'    Range("C7").Select
'    ActiveCell.FormulaR1C1 = "20000"
'    Range("C8").Select
'    ActiveCell.FormulaR1C1 = "30000"
'    Range("C9").Select
'    ActiveCell.FormulaR1C1 = "40000"
'    Range("C10").Select
j = 1
For i = newRows.Rows(1).Row To newRows.Rows(newRows.Rows.Count).Row
Range("C" & i) = j * 10000
j = j + 1
Next i
End Sub

两个新行 两个新行 或七个新行 七个新行


推荐阅读