Question

代码需要在Sheet1列B中检测到单词“ EXECSDATE”，并将该行及其下方的行复制到Sheet2，直到到达另一个单词“ EXECSDATE”。由于Sheet1中有5个“ EXECSDATE”，因此总共应该有5张纸分开。

我已经尝试运行我的代码，但是它显示了一些错误，无法执行必须执行的操作。

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

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

    firstaddress = mFind.Address
    IdSheet = 1
    Compteur = 0

    Do
        Set mfind2 = Columns("B").FindNext(mFind)
        If mfind2 Is Nothing Then
            Compteur = 0
        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, "B")).EntireRow.Cut
            End If
        End If

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

        If mFind Is Nothing Then
        Else: IdSheet = IdSheet + 1
        End If

        Sheets("Sheet" & IdSheet & "").Select
        Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
line:
        Sheets("Sheet1").Select
        Range(mFind, Cells(mFind.Row, "B")).EntireRow.Delete
        Set mFind = Columns("B").Find("EXECSDATE")
        Set mfind2 = Columns("B").Find("EXECSDATE")
        If mFind Is Nothing Then Exit Sub
        Set mFind = Columns("B").FindNext(mFind)

    Loop While mFind.Address <> firstaddress
End Sub

错误消息：

此选择无效。确保复制和粘贴区域不重叠，除非它们的大小和形状相同。

这是第一个EXECSDATE词（应该进入Sheet1）：

这是第二个EXECSDATE词（应该进入Sheet2）：

Answer 1

如果您像您说的那样摆脱了所有的双“ EXECSDATE”，并且假定B1包含“ EXECSDATE”，则此答案有效：

GroupBy(x => x.FavoriteColor == null ? -1 : x.FavoriteColor)

如何查找特定单词并将其与特定单词下方的行一起转移到另一张纸上

1 个答案: