☰

マクロのアドバイス - 特定のセルに「NO」と表示される場合、行を新しいワークシートに貼り付ける

tag-icon • tag-icon microsoft-excel vba macros
マクロのアドバイス - 特定のセルに「NO」と表示される場合、行を新しいワークシートに貼り付ける

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。

関連情報