每隔三行增加一个相同的QQ号

todaynew

一个版友的问题，用宏可以这样处理：

Sub 插入QQ号()
    Dim str As String
    Dim i As Long, j As Long
    str = InputBox("请输入QQ：")
    i = 1: j = 0
    Do While True
        If Cells(i, 1) = "" Then Exit Do
        i = i + 1: j = j + 1
        If j = 3 Then
            Rows(i).Select
            Selection.Insert Shift:=xlDown
            Cells(i, 1) = str
            j = 0: i = i + 1
        End If
    Loop
End Sub

逆运算的宏可以这样写：

Sub 删除QQ号()
    Dim str As String
    Dim i As Long
    i = 1
    str = InputBox("请输入QQ：")
    Do While Cells(i, 1) <> ""
        If Cells(i, 1) = str Then
            Rows(i).Select
            Selection.Delete Shift:=xlUp
            i = i - 1
        End If
        i = i + 1
    Loop
End Sub

todaynew

pureshadow 发表于 2013-5-18 12:17
我来砸个场子