Поиск по имени ячейки, чтобы увидеть, если лист существует и если он есть ....?

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