Question

尝试将行移动到另一张表时遇到我的代码错误。

我有一个关键字列表，该列表希望在名为“今天”的工作表的数据列表中找到。如果在列表中找到它，它将移动到另一个表“ Exception”。我已经有一个有效的代码，但是，我遇到一个错误“代码执行已被中断”。

我需要查找某个关键字的数据列表：

| Assignee | Due on/At  | Attachment    | Subject Description |
|----------|------------|---------------|---------------------|
| Carl     | 16.11.2016 | No Attachment | Re: Information 1   |
| Clark    | 16.11.2016 | No Attachment | Test 4              |
| Kent     | 16.11.2016 | No Attachment | Test 6              |
| Japhet   | 16.11.2016 | No Attachment | Test 6              |
| Ryza     | 16.11.2016 | No Attachment | Re: Information 2   |
| Shane    | 16.11.2016 | No Attachment | FWD Subject 1       |
| Kent     | 16.11.2016 | No Attachment | Test 6              |
| Japhet   | 16.11.2016 | No Attachment | Test 6              |
| Ryza     | 16.11.2016 | No Attachment | FWD Subject 2       |
| Shane    | 16.11.2016 | No Attachment | Test 8              |
| Shane    | 16.11.2016 | No Attachment | Test 92             |
| Japhet   | 16.11.2016 | No Attachment | R:                  |
| Japhet   | 16.11.2016 | No Attachment | Test 92             |

我设置的关键字列表：

| //// Exception Keywords |
|-------------------------|
| Re:                     |
| R:                      |
| FWD                     |
| Test                    |
| FW                      |

对此有一个期望，它将移动包含我已列出的特定关键字的另一个工作表中的所有行。在这种情况下，它将是以下行：

关于：信息1
关于：信息2
FWD主题1
FWD主题2
R：

顺便说一句，关键字列表可以增加。

这是我的代码：

Sub SeparateExceptionList()

Dim MainSheet as Worksheet
Dim TodaySheet as Worksheet
Dim excLastRow As Long
Dim tLastRow as Long
Dim i as long
Dim j as long

Set MainSheet = Sheets("Main")
Set TodaySheet = Sheets("Today")


tLastRow = TodaySheet.Cells(Rows.Count, 4).End(xlUp).Row
excLastRow = MainSheet.Cells(Rows.Count, 7).End(xlUp).Row

For j = 10 To excLastRow

exceptionKeyword = MainSheet.Cells(j, 7).Value

    For i = tLastRow To 2 Step -1

    If UCase(TodaySheet.Cells(i, 4)) Like "*" & UCase(exceptionKeyword) & "*" Then

        TodaySheet.Range("a" & i & ":D" & i).Copy Sheets("Exception").Range("ExceptionTable").ListObject.ListRows.Add.Range
        TodaySheet.Cells(i, 4).EntireRow.Delete '//This is where the code is being interrupted

        Else:

    End If

    Next i

Next j

End Sub

根据关键字列表将行移动到另一张表

0 个答案: