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

Question

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

但是，我目前已经写出了错误的代码。 我发现很难定义工作表名称（单元格值）等。

Sub TaskAllocation()

Dim cell As Range, Lastrow1 As Double, i As Integer
Dim SubTaskWs As Worksheet, Ws As Worksheet, Lastrow2 As Double
Set SubTaskWs = ActiveWorkbook.Worksheets("Sub tasks")
Set Ws = ActiveWorkbook.Sheets(WsName)

i = o

Lastrow1 = SubTaskWs.Range("H" & Rows.Count).End(xlUp).Row
Lastrow2 = Ws.Range("A" & Rows.Count).End(xlUp).Row

For Each cell In SubTaskWs.Range("H4:H" & Lastrow1)
    For Each Ws In Sheets
        If cell.value = Ws.Name Then
            Ws.Range("A" + (Lastrow2 + (i))).EntireRow.Insert
            Call copyFormattingAbove(Ws, "A" & Lastrow2)
            Ws.Range(("A" & Lastrow2) + (i)).value = cell.Offset(, -6)
            Ws.Range(("B" & Lastrow2) + (i)).value = cell.Offset(, -5)

            i = i + 1
        End If
    Next Ws
Next cell

End Sub

Answer 1

我确实更改了您的代码以使其更具可读性。

对未来的一些提示：

1. 使用模块顶部的Option Explicit来声明所有变量。
2. 始终尝试将变量声明在靠近使用它们的位置。
3. 永远不要声明integer变量，而是使用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