☰

巨集建議 - 如果某些儲存格顯示“否”，則將行貼上到新工作表中

tag-icon • tag-icon microsoft-excel vba macros
巨集建議 - 如果某些儲存格顯示“否”，則將行貼上到新工作表中

我想要一些使用 VBA 和巨集的建議。

我想要一種連結工作表的方法（工作紙 1 至 6）與主表（工作表 7）。

如果該行包含“不”在列中I（整個工作紙 1 至 6），程式碼可以將該行複製並貼上到工作表 7？

那麼如果行（在工作紙 1 至 6）改為“是的” 另一個程式碼是否能夠從中刪除該行工作表 7？

對於某些上下文，工作紙 1 至 6是職位列表和'是的'&'不'如果客戶已付款。如果'不'他們被加到債務人名單中工作表 7。如果'是的'他們需要從債務人名單中刪除。

答案1

這段程式碼將幫助您：

Public Sub debtors()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wksdest As Worksheet
    Set wkb = ThisWorkbook
    Set wksdest = wkb.Sheets("Sheet7")
    wksdest.Rows.Clear 'Clear the contents of Sheet7
    destRow = 1 'First row on Sheet7
    For i = 1 To 6 'Loop through Sheets 1 to 6
        newIndex = Right(Str(i), 1)
        thisSheet = "Sheet" + newIndex
        Set wks = wkb.Sheets(thisSheet)
        wks.Activate
        'Selects column I
        Columns("I:I").Select
        'Find a coincidence with the string "NO"
        Set cell = Selection.Find(What:="NO", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        'If there is a coincidence (is Not Nothing)
        If Not cell Is Nothing Then
            firstRow = cell.Row
            newRow = cell.Row
            'Copy the row and paste on Sheet7
            wks.Rows(newRow).Copy
            wksdest.Rows(destRow).PasteSpecial xlPasteValues
            destRow = destRow + 1
            foundValue = True
            'Find next coincidences in the same sheet
            While foundValue
                Set cell = Selection.FindNext(cell)
                If Not cell Is Nothing Then
                    newRow = cell.Row
                    If newRow <> firstRow Then
                        wks.Rows(newRow).Copy
                        wksdest.Rows(destRow).PasteSpecial xlPasteValues
                        destRow = destRow + 1
                    Else
                        foundValue = False
                    End If
                Else
                    foundValue = False
                End If
            Wend
        End If
    Next i
    wksdest.Activate
End Sub

使用ALT+開啟 VBA/宏F11，在本練習冊插入一個新模組並將程式碼貼到右側。

點擊綠色三角形執行它。

我在程式碼上添加了註釋，以便您了解它是如何工作的。

您也可以按一下第一行來逐步執行它，然後按 完成每個步驟F8。

相關內容