Как написать код для l oop поиска по листам

Question

Я знаю, что я хочу сделать, и логика c кажется довольно простой. Однако, когда дело доходит до написания кода для него, кому-то мой уровень кажется довольно сложным.

У меня есть книга Excel с 2 листами.

Лист 1 содержит 200 имен и фамилий в столбцах A и B и 13 дат в строке 1. Остальная часть разворотного листа пуста. Лист 2 содержит результаты каракули для одиннадцати 1-часовых блоков (09:00 - 20:00) в эти даты для тех же 200 человек из Листа 1. Таким образом, Лист 2 содержит те же имена в столбцах A & B, Даты в строке 1, где даты повторяются 11 раз в последовательных ячейках для размещения одиннадцати 1-часовых блоков, находящихся в строке 2, за которыми следует остальная часть таблицы, заполненная одним из трех значений - «Да», « Нет "и" Возможно ", для каждого блока по 1 часу, который был доступен на дату для каждого имени.

Я хочу заполнить каждую ячейку на листе 1 временем, когда каждый человек на листе 1 помечал себя как «Да» на листе 2. Итак, если лицо 1 отметило себя «Да» в часы с 09:00 до 10:00, с 11:00 до 12:00 и с 13:00 до 14:00 на листе 2 31/03 / 2020, я хотел бы объединить эти часовые блоки в точности следующим образом: 09: 00-10: 00 11: 00-12: 00 13: 00-14: 00, а затем ввести его в соответствующую ячейку для этого имени и даты на листе 1.

Я должен признаться, что только начал потрудился над кодированием для VBA Excel около 5 часов go. Так что у меня фактически нет кода, который я могу представить. Я пытался использовать циклы, массивы, таблицы, поиски и так далее. И у меня были проблемы с тем, что мои листы имеют разные типы данных.

Answer 1

Кредит идет к @ CDP1802 за все это. Я только что отредактировал несколько маленьких вещей! Большое спасибо!

    Sub mysub()

        Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
        Dim r As Integer, c As Integer, c2 As Integer, s As String, d As Integer

        Set wb = ThisWorkbook
        Set ws1 = wb.Sheets("Sheet1")
        Set ws2 = wb.Sheets("Sheet2")

        ' scan sheet 2
        For r = 3 To 202 ' or whatever the last row is
            For d = 0 To 12 ' 13 dates
                s = ""
                ' work out first columns on sheet2 for that d
                c2 = 3 + d * 11
                For c = c2 To (c2 + 10)
                    If ws2.Cells(r, c) = "Yes" Then
'                   Pick up time from row 2 in Sheet 2
                        s = s & ws2.Cells(2, c) & vbNewLine 
                    End If
                    If ws2.Cells(r, c) = "Under reserve" Then
'                   Pick up time from row 2 in Sheet 2 and place it in parenthesis
                        s = s & "(" & ws2.Cells(2, c) & ")" & vbNewLine
                        End If
                Next
' Insert the resulting string of times in Sheet 1. Sheet 1 has one less rows, hence r-1
                ws1.Cells(r - 1, d + 3) = s
            Next
        Next
        MsgBox "Done"
    End Sub

Answer 2

Принцип будет состоять в том, чтобы сканировать по всему листу 1, используя некоторую базовую c математику, чтобы определить диапазон ячеек на листе 2, которые нужно проверить на «Да»

Sub mysub()

    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim r As Integer, c As Integer, c2 As Integer, s As String, d As Integer

    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")

    ' scan sheet 1
    For r = 3 To 10 ' or whatever the last row is
        For d = 0 To 10 ' 11 dates
            s = ""
            ' work out first columns on sheet2 for that d
            c2 = 3 + d * 11
            For c = c2 To (c2 + 10)
                If ws2.Cells(r, c) = "Yes" Then
                    s = s & ws2.Cells(2, c) & " " ' row 2 for time
                End If
            Next
            ws1.Cells(r, d + 3) = s
        Next
    Next
    MsgBox "Done"
End Sub