0

我从来没有使用 vba 编写过 Excel 宏，我听说它可以做很多好事。我面临一个问题，我希望 Excel 宏可以为我解决，因为我有大量数据需要过滤。很简单，我会举例说明

原表：

name1 123456789
name2 234567783 3456677889
name3 213123123
name4 123451231 123412312 1231223523

宏需要做的是当他在第三列或第四列或两者中找到数据时，他插入一个新行并用列中的名称和第三列中的数字填充它，这样数据就会像这样

表应该如何：

name1 123456789 (stays the same no data in column 3 or 4)
name2 234567783 (removes the third column data and put it in a new row)
name2 3456677889 (keeping the name that the data had)
name3 213123123 (stays the same no data in column 3 or 4)
name4 123451231 (removes the third column data and forth column data and put it in new rows)
name4 123412312 
name4 1231223523

我尝试编写脚本，这是我到目前为止所达到的：

Sub test()
Dim cell As Range
For Each cell In Range("d2:d40")
    If Not IsEmpty(cell.Value) Then
        MyAddress = ActiveCell.Row
        Rows(MyAddress).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("a" & cell.Row).Select
        Selection.Copy
        Range("a" & cell.Row + 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("b" & "cell.Row").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("B" & cell.Row).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
Next cell
End Sub

执行此宏后，Excel 冻结 - 知道为什么吗？

4

1 回答 1

0

您的代码的主要问题是这一行，它不断扩大范围，因此永远不会到达终点，因此“冻结”

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

看看这段代码，它从数据的底部开始，向上工作，从而避免了范围不断扩大的问题。它假定您的数据从“A1”开始。

Sub test2()

Dim r As Range, x As Long, y As Long, Cnt As Long

Application.ScreenUpdating = False '**faster

With ActiveSheet 'specify actual sheet
    Cnt = .Cells(.Rows.CountLarge, 1).End(xlUp).Row 'last non blank cell in column A
'   rows loop
    For y = Cnt To 1 Step -1 'start at last row and work up
        Set r = .Range(.Cells(y, 1), .Cells(y, .Columns.Count).End(xlToLeft)) 'current row
'       loop thru cells in current row

        If Not IsEmpty(r(1)) Then '** skip empty cell

          For x = r.Cells.Count To 3 Step -1
             r.Offset(1).EntireRow.Insert Shift:=xlDown 'insert row
             r(x).Cut r(2).Offset(1) 'number to column B
             r(1).Offset(1).Value = r(1).Value 'name to column A
         Next x
       End If '**
    Next y
End With

Application.ScreenUpdating = True '**

End Sub
于 2013-11-06T08:32:56.627 回答