Question

我试图找到单词“ BREAK”并在其下面的行中进行剪切，直到到达另一个单词“ BREAK”并将其转移到另一张图纸上为止。

我需要将其分成5张，因为文件中有5个单词“ BREAK”。

Sub Fails()

Dim mFind As Range
Set mFind = Columns("A").Find("BREAK")
If mFind Is Nothing Then
    MsgBox "There is no cell found with the text 'BREAK'" _
    & " in column A of the active sheet."
    Exit Sub
End If

firstaddress = mFind.Address

Do
    If IsDate(mFind.Offset(1, 0)) = True Then
        Range(mFind, Cells(mFind.Row + 2, "A")).EntireRow.Cut
        Sheets("Sheet2").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
    ElseIf WorksheetFunction.IsNumber(mFind.Offset(1, 0)) = True Then
        Range(mFind, Cells(mFind.Row + 3, "A")).EntireRow.Cut
        Sheets("Sheet2").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
    End If

    Sheets("Sheet1").Select
    Set mFind = Columns("A").FindNext(mFind)
    If mFind Is Nothing Then Exit Sub
Loop While mFind.Address <> firstaddress

End Sub

上面的代码没有任何反应。任何帮助将不胜感激。

谢谢大家，祝你有美好的一天。

Answer 1

尝试一下此代码，您的If语句为

Sub Fails()
Dim mFind As Range
Dim Compteur As Integer
Dim IdSheet As Integer
Dim ErrorBool As Boolean


Set mFind = Columns("A").Find("Break")
Set mfind2 = Columns("A").Find("Break")
If mFind Is Nothing Then
    MsgBox "There is no cell found with the text 'Break'" _
    & " in column A of the active sheet."
    Exit Sub
End If

firstaddress = mFind.Address
IdSheet = 1
Compteur = 0
Do

        Set mfind2 = Columns("A").FindNext(mFind)

        If mfind2 Is Nothing Then

        Compteur = Sheet1.Range("A1048576").End(xlUp).Row

        'Exit Sub

        Else:
        If mFind.Row < mfind2.Row Then
         Compteur = mfind2.Row
        End If
        If mFind.Row > mfind2.Row Then
         ErrorBool = True
        End If

        If ErrorBool = True Then

        Range(mFind, Cells(mFind.Row + 1, "A")).EntireRow.Cut

        End If
        End If

        Range("A" & mFind.Row + 1 & ":A" & Compteur - 1).EntireRow.Cut

        If mFind Is Nothing Then

        Else: IdSheet = IdSheet + 1

        End If
        Sheets("Sheet" & IdSheet & "").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste

    Sheets("Sheet1").Select
    Range(mFind, Cells(mFind.Row, "A")).EntireRow.Delete
    Set mFind = Columns("A").Find("Break")
    Set mfind2 = Columns("A").Find("Break")
    If mFind Is Nothing Then Exit Sub
    Set mFind = Columns("A").FindNext(mFind)




Loop While mFind.Address <> firstaddress

End Sub

注意：您必须先创建Sheet1，Sheet2，Sheet3，Sheet4，Sheet5等，然后再运行宏。

查找特定的文本并剪切其下的所有行，然后粘贴到另一张纸上

1 个答案: