Question

原则上，这应该很简单，但是我遇到了很多问题。这构成了一个更大的宏的一部分，该宏被放在一起以在表的底部插入新行。这些表位于我未在宏中指定的各种选项卡中（未引用<>的选项卡），但是在示例中，我需要在其存在的列中查找第一个值并将其向下复制。

上面的屏幕截图显示了表中的数据。存在的地方，我需要将其复制到下一个空白行。图片显示B5作为第一个可用的空白行，而单元格B4具有公式。在这种情况下，B4将被复制到B5，而B4将成为一个值而不是公式。然后可以将其更改为将B5复制到B6，然后在下次运行宏时B5成为一个值。蓝色标签接受散装货物有五个表格，因此我需要参考要影响的标签的工作表和列范围。在图片中，该选项卡称为“可接受的散货”，其中的数据需要向下复制到B，F，J，N和R列中。

Sub INSERT_NEW_ROWS()
    Dim rs As Worksheet
    For Each rs In ThisWorkbook.Worksheets
        If rs.name <> "3110" And rs.name <> "Data" And rs.name <> "Wholesale" And _
           rs.name <> "Retail" And rs.name <> "Pivot 1" And rs.name <> "Pivot 2" And _
           rs.name <> "Pivot3" And rs.name <> "Pivot 4" And rs.name <> "Pivot 5" And _
           rs.name <> "Pivot 6" And rs.name <> "Pivot 7" And rs.name <> "Pivot 8" And _
           rs.name <> "Pivot 9" And rs.name <> "Pivot 10" And rs.name <> "Pivot 11" Then
            ' LastRow in column A
            LastRowa = rs.Cells(rs.Rows.Count, "A").End(xlUp).Row
            ' LastRow in column B
            LastRowb = rs.Cells(rs.Rows.Count, "B").End(xlUp).Row

            'Copy paste the last row, based on what's in column A in the next empty row   
            rs.Cells(LastRowa, 2).EntireRow.Copy
            rs.Cells(LastRowa + 1, 1).PasteSpecial xlPasteFormulas

            'Change the formula of the last cell in column  B into a value
            rs.Cells(LastRowb, 2).Copy
            rs.Cells(LastRowb + 1, 2).PasteSpecial xlPasteFormulas
            rs.Cells(LastRowb, 2).Value = rs.Cells(LastRowb, 2).Value
        End If
    Next rs   
End Sub

Answer 1

我的建议是：

使用数组来列出排除的工作表，并测试当前工作表的名称是否为If … And … And … And …，而不是多个IsInArray。
构建第二个循环以遍历您在数组AffectedColumns中命名的所有所需列。

例如：

Option Explicit 'see https://www.excel-easy.com/vba/examples/option-explicit.html

Public Sub InsertNewRows()
    Dim ExcludedWorksheets As Variant
    ExcludedWorksheets = Array("3110", "Data", "Wholesale", "Retail", "Pivot 1", "Pivot 2", "Pivot3", "Pivot 4", "Pivot 5", "Pivot 6", "Pivot 7", "Pivot 8", "Pivot 9", "Pivot 10", "Pivot 11")

    Dim AffectedColumns As Variant
    AffectedColumns = Array("B", "F", "J", "N", "R")

    Dim iCol As Variant
    Dim LastRowInCol As Long

    Dim rs As Worksheet
    For Each rs In ThisWorkbook.Worksheets
        If Not IsInArray(rs.Name, ExcludedWorksheets) Then

            For Each iCol In AffectedColumns
                LastRowInCol = rs.Cells(rs.Rows.Count, iCol).End(xlUp).Row
                rs.Cells(LastRowInCol, iCol).Copy
                rs.Cells(LastRowInCol + 1, iCol).PasteSpecial xlPasteFormulas
                rs.Cells(LastRowInCol, iCol).Value = rs.Cells(LastRowInCol, iCol).Value
            Next iCol
        End If
    Next rs
End Sub


Public Function IsInArray(FindString As String, InArray As Variant) As Boolean
    IsInArray = (UBound(Filter(InArray, FindString)) > -1)
End Function

宏可将公式复制到列中的下一个单元格，然后将其粘贴为值上方的单元格

1 个答案: