[已解决]每隔一行删除一行

ymq123

1、编写代码
2、每隔一行删除一行，结果如工作表2

最佳答案

月排行榜 / 总排行榜

刘苏

2014-12-12 02:21

请查收附件： 每隔一行删除一行.rar (24.01 KB, 下载次数: 21)

2014-12-12 02:21 上传

点击文件名下载附件

跳转到最佳答案楼层

刘苏

请查收附件： 每隔一行删除一行.rar (24.01 KB, 下载次数: 21)

2014-12-12 02:21 上传

点击文件名下载附件

baksy

函数解决
=INDIRECT("'1'!r"&ROW()*2-1&"c"&COLUMN(A1),)&""
或
=OFFSET('1'!$A$1,ROW()*2-2,COLUMN(A1)-1)&""

ymq123

刘苏 发表于 2014-12-12 02:21
请查收附件：

把要删除的数据放到工作表4中，代码就怎么修改，
谢谢

上清宫主

Sub 隔行删0() '逐一选中一起删
    r% = UsedRange.Rows.Count
    c% = UsedRange.Columns.Count
    r = Int(r / 2) * 2
    For i% = r To 1 Step -2
        s = s$ & "," & Cells(i, 1).Address(0, 0)
        If Len(s) > 200 Then
           Range(Mid(s, 2)).EntireRow.Delete
           s = ""
        End If
    Next
    If Len(s) Then Range(Mid(s, 2)).EntireRow.Delete
End Sub
Sub 隔行删1() '改自录制宏
    r% = UsedRange.Rows.Count
    c% = UsedRange.Columns.Count
    Cells(1, c + 2) = 1
    Cells(1, c + 2).Resize(2).AutoFill Destination:=Cells(1, c + 2).Resize(r)
    Cells(1, c + 2).Resize(r).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Cells(1, c + 2).Resize(r).Clear
End Sub
Sub 隔行删2() '数组
    Dim ar()
    ar = UsedRange.Value
    For r% = 3 To UBound(ar) Step 2
        For c% = 1 To UBound(ar, 2)
            ar((r + 1) / 2, c) = ar(r, c)
        Next
    Next
    UsedRange.Clear
    [a1].Resize((r - 1) / 2, c - 1) = ar
End Sub