需要vba宏删除每列中除第一行和最后一行以外的单元格

Question

我有一个具有多个行和列的Excel，并且每行的列值范围不同。

需要一个宏，该宏将删除一行中除第一行和最后一行外的所有单元格，并将最后一个值粘贴到第一个值旁边。

尝试了以下脚本：

Sub test()
Dim sh As Worksheet
Dim IDS As range
Dim ID As range

Set sh = ThisWorkbook.Sheets("Sheet1")

    Set IDS = ActiveSheet.range("A2", range("A1").End(xlDown))

    For Each ID In IDS

        Dim b As Integer
        Dim k As Integer

        k = sh.range("ID", sh.range("ID").End(xlToRight)).Columns.Count
        b = k - 1

        range(ID.Offset(0, 0), ID.Offset(0, "b")).Select
        Selection.ClearContents

    Next ID

End Sub

Answer 1

您可以使用Range.Delete方法（Excel）

range(ID.Offset(0, 0), ID.Offset(0, b)).Delete Shift:=xlToLeft 

Answer 2

这是有点不同的方法，但应该会有所帮助。

此外，通常也不是最好像在b＆k中那样在循环中声明变量

Sub test()

    Dim sh As Worksheet
    Dim row As Integer
    Dim lastCol As Integer

    Set sh = ThisWorkbook.Sheets("Sheet1")

    For row = 2 To sh.Cells(Sheets(1).Rows.Count, "A").End(xlUp).row

        lastCol = sh.Cells(row, Columns.Count).End(xlToLeft).Column

        sh.Range("B" & row).Value = sh.Cells(row, lastCol).Value
        sh.Range(sh.Cells(row, 3), sh.Cells(row, lastCol)).ClearContents

    Next

End Sub

祝你好运

Answer 3

我将按照以下步骤进行：

Sub test()
    Dim cell As Range

    With ThisWorkbook.Sheets("Sheet1") ' reference relevant sheet
        For Each cell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)) ' loop through referenced sheet column A cells from row 2 down to last not empty one
            With .Range(cell, .Cells(cell.Row, .Columns.Count).End(xlToLeft)) ' reference referenced sheet range spanning from current cell to last not empty one in the same row
                If .Count > 2 Then ' if referenced range has more then 2 cells
                    cell.Offset(, 1).Value = .Cells(1, .Count).Value ' store last cell value next to the current one
                    .Offset(, 2).Resize(, .Columns.Count - 1).ClearContents 'clear all cells right of current one
                End If
            End With
        Next
    End With
End Sub