Excel 正在搜索单元格名称以查看工作表是否存在以及是否存在。。。。？

我正在尝试创建代码（循环），以便在将任务分配给团队成员（在H列的单元格中）时，代码使用现有工作表名称搜索单元格值，如果存在匹配项，则工作表会使任务成员工作表成为活动工作表，找到最后一行，并将分配的任务添加到工作表中。该代码应针对列中所有填充的单元格运行

但是，我目前编写的代码存在bug。我发现很难定义工作表名称（单元格值）等

---

我确实对你的代码做了一些修改，使它更具可读性

未来的一些建议：

使用moduel顶部的

选项Explicit

，对所有变量进行声明

始终尝试在使用变量的位置附近声明变量

切勿声明

整数

变量，请改用

Long

。也不要对行使用

Double

，

Double

和

Single

用于浮点数

代码如下：

Option Explicit
Sub TaskAllocation()

    Dim cell As Range
    Dim SubTaskWs As Worksheet
    Set SubTaskWs = ActiveWorkbook.Worksheets("Sub tasks")

    Dim Lastrow1 As Long
    Lastrow1 = SubTaskWs.Range("H" & Rows.Count).End(xlUp).Row

    Dim ws As Worksheet
    Dim cell As Range
    Dim Lastrow2 As Long, i As Long
    i = 0

    Dim Tasks As Object

    FillTasks Tasks

    For Each cell In SubTaskWs.Range("H4:H" & Lastrow1) 'change this range and loop through the column with the tasks
        If Tasks.Exists(cell) Then GoTo AlreadyDone
        For Each ws In Sheets
            If SubTaskWs.Cells(cell.Row, "H") = ws.Name Then
                Lastrow2 = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
                copyFormattingAbove ws, "A" & Lastrow2
                ws.Range("A" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 2)
                ws.Range("B" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 3)
            End If
        Next ws
AlreadyDone:
    Next cell

End Sub
Function FillTasks(Tasks As Object)

    Set Tasks = CreateObject("Scripting.Dictionary")

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets 'loop through sheets
        If Not ws.Name = "Sub tasks" Then
            'code to find the right columnd and loop through the existing tasks
            'there is no need for an item on this case, you only need to know if it exists
            If Not Tasks.Exists(cell) Then Tasks.Add cell, 1
        End If
    Next ws

End Function

---

您正试图使用

WsName

设置

Ws

，但对于当前代码，

WsName

为空。您需要删除该行并在

If

中计算

LastRow2

，因为在那里您已经设置了

Ws

集。我已经按照您所说的做了，但是现在在“Ws.Range”（“a”+（LastRow2+（I））.EntireRow.Insert“line”上仍然存在不匹配错误（“a”+（LastRow2+（I）））.EntireRow.InsertAlso选项explicit DO强制您声明所有变量的作用。另一方面，为什么需要插入一行？这已经是最后一个了，对吗？如果是这样，则在找到

Lastrow2

时添加+1，使其向下一行@LawrenceForster我刚刚编辑了我的代码，看看它现在是否适用于您。我想确保有足够的行，因为文件可能会变大。删除插入行时仍然会产生错误，但是在下一行“Ws.Range（（（“A”&Lastrow2）+（i））.value=cell.Offset（，-6）”，因此我假设您的代码中的Ws.RangeWell中存在错误，我无法确定，但是如果您从第4行（

H4

）开始，并尝试增加5或6行，则会抛出错误。你想复制什么？如果你能从主工作表和工作表上传一个屏幕，我会写得更好。

Option Explicit
Sub TaskAllocation()

    Dim cell As Range
    Dim SubTaskWs As Worksheet
    Set SubTaskWs = ActiveWorkbook.Worksheets("Sub tasks")

    Dim Lastrow1 As Long
    Lastrow1 = SubTaskWs.Range("H" & Rows.Count).End(xlUp).Row

    Dim ws As Worksheet
    Dim cell As Range
    Dim Lastrow2 As Long, i As Long
    i = 0

    Dim Tasks As Object

    FillTasks Tasks

    For Each cell In SubTaskWs.Range("H4:H" & Lastrow1) 'change this range and loop through the column with the tasks
        If Tasks.Exists(cell) Then GoTo AlreadyDone
        For Each ws In Sheets
            If SubTaskWs.Cells(cell.Row, "H") = ws.Name Then
                Lastrow2 = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
                copyFormattingAbove ws, "A" & Lastrow2
                ws.Range("A" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 2)
                ws.Range("B" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 3)
            End If
        Next ws
AlreadyDone:
    Next cell

End Sub
Function FillTasks(Tasks As Object)

    Set Tasks = CreateObject("Scripting.Dictionary")

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets 'loop through sheets
        If Not ws.Name = "Sub tasks" Then
            'code to find the right columnd and loop through the existing tasks
            'there is no need for an item on this case, you only need to know if it exists
            If Not Tasks.Exists(cell) Then Tasks.Add cell, 1
        End If
    Next ws

End Function