删除/清除excel表格内容但保留最后三列的宏

如何解决删除/清除excel表格内容但保留最后三列的宏

我目前有一个复制/粘贴宏，用于在我的工作簿目标中查找字符串文本，该宏打开源数据工作簿并复制并粘贴回工作簿目标。我在代码中添加了两段来清除内容，然后将删除第一列中包含空白单元格的任何行。我在许多工作簿上使用了此代码，这些工作簿能够成功清除我有复制/粘贴宏的表格并调整其大小。

    Dim wbSourceData As Workbook
    Dim wbDestination As Workbook
    Dim wsSourceData As Worksheet
    Dim wsDestination As Worksheet
    Dim strFName As String
    Dim rng1 As Range
    Dim rng2 As Range
    Dim tbl As ListObject
    Dim Cl As Long
    Dim Rl As Long
    

    Set wbDestination = ThisWorkbook
    Set wsDestination = wbDestination.Sheets("Data Table")
    
    strFName = wbDestination.Worksheets("Macros").Range("C2").Value
    
    Set wbSourceData = Workbooks.Open(strFName)
    Set wsSourceData = wbSourceData.Worksheets(2)
    
    Set tbl = wsDestination.ListObjects("Data_Table")
    
    tbl.DataBodyRange.ClearContents     'This clears the contents of the table
    
    With wsSourceData
    Cl = .Cells(2,.Columns.Count).End(xlToLeft).Column
    Rl = .Cells(.Rows.Count,"A").End(xlUp).Row
    Set rng1 = .Range(.Cells(2,"A"),.Cells(Rl,Cl))
    End With
    
    rng1.copy
    wsDestination.Range("A4").PasteSpecial xlValues
    
    Application.CutcopyMode = False

    wbSourceData.Close SaveChanges:=False
    
    On Error Resume Next
    Set rng2 = Range("Data_Table[[Names]]").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not rng2 Is nothing Then
        rng2.Delete Shift:=xlUp                  'This deletes rows with blank cells in the first column
    End If
    
End Sub

源数据被粘贴到的选项卡的名称是“数据表”。此工作表中的表名称称为“Data_Table”。此表中的第一列称为“名称”。字符串查找的选项卡的名称称为“宏”。

我意识到这段代码会删除表格中的所有数据，当表格中有我需要保留的公式时，这不起作用。因此，我几乎希望在此代码中添加一种方式，即该表中的最后三列不会因为它们是公式（RS 或 18-20 列）而被删除，但仍保持其余代码在工作时保持原样好。我是 VBA 的初学者，所以我很感激 ELI5 格式的回复。谢谢。

如果您需要澄清我代码中的名称，请告诉我。

解决方法

工作有点多，但您也可以将数据保存在数组中，然后在清除后将其放回原处，而不是将其复制到工作表中的另一个范围。类似的东西：

Dim tblArray As Variant

tblArray = tbl.ListColumns(18).DataBodyRange.Resize(,2) 
'An array of the content of column 18,rezsized to 18-19.

tbl.DataBodyRange.ClearContents 'You have this one already ofc

For i = 1 To 2                                      'Columns 1 and 2 (R and S)
    For j = LBound(tblArray) To UBound(tblArray)    'All the rows in the array
        tbl.ListColumns(18).DataBodyRange.Cells(j,i).Value = tblArray(j,i)
        'writing back to the cells from the array

    Next j 'next row
Next i     'next column

End Sub

假设表格从“A”列开始，使“R”列成为第 18 列。

或者，您可以遍历列，并清除您不想要的列：

Dim tblArray As Variant,col as Variant
Set tblArray = tbl.ListColumns        'Array of all columns

For Each col In tblArray              'looping through the columns
    If Not col.Name = "Column18" And Not col.Name = "Column19" Then 'checking the headers
        tbl.ListColumns(col.Name).DataBodyRange.ClearContents 'Instead of tbl.DataBodyRange.ClearContents
    End If
Next col

为他们提供正确的标题名称。