Как решить проблему «программа не отвечает», когда я извлекаю данные с одинаковыми именами в столбец и помещаю их в разные таблицы?

Question

Исходя из ранее опубликованной темы, Как извлечь объединенные данные и поместить их в разные рабочие листы? Все выглядит нормально, пока моя программа не встретит программу

" не отвечает ошибка "

, которая, я думаю, связана с использованием

Sheets(sheetname).UsedRange.Rows.count

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

Cells(Sheets("SheetName").Rows.Count, 1).End(xlup).Row 

(лучшие варианты, как предложено другими), но это не дало мне желаемого результата, как показано ниже. Итак, как мне изменить приведенный ниже код для решения программы, не отвечающей на ошибку в этом случае, и при этом получить идеальный сценарий, как показано ниже?

Put извлеченные данные в 3 различных листа, а именно: индекс 1, индекс 2 и индекс 3, как показано ниже

   Sub UpdateVal()
    Static count As Long
    Dim iRow As Long
    Dim aRow As Long
    Dim a As Long
    Dim b As Long
    Dim selectRange As Range
    dim lastline as integer
    dim sheetname as string
    dim indexrowcount as integer
    dim wb as workbook
    dim ws as worksheet
    set wb= activeworkbook
    set ws=wb.sheets(Index)
    j = 2
    iRow = 1
    LastLine = ActiveSheet.UsedRange.Rows.count
    While iRow < LastLine + 1
        a = iRow + 1
        b = iRow + 17 ' Max Group Size with Same name in F to H column
        count = 1
        If ws.Cells(iRow, "F").Value = "Martin1" Then
            sheetname = "Index1"
        ElseIf ws.Cells(iRow, "F").Value = "John1" Then
            sheetname = "Index2"
        Else
            sheetname = "Index3"
        End If
        For aRow = a To b
            If ws.Cells(iRow, "F") = ws.Cells(aRow, "F") And ws.Cells(iRow, "G") = ws.Cells(aRow, "G") And ws.Cells(iRow, "H") = ws.Cells(aRow, "H") Then
                count = count + 1
            Else
                Set selectRange = Range("A" & iRow & ":J" & aRow - 1)
                selectRange.Copy
                indexrowcount = Sheets(sheetname).UsedRange.Rows.count
                Sheets(sheetname).Range("A" & indexrowcount).PasteSpecial xlPasteAll
                iRow = iRow + count
                Exit For
           End If
        Next aRow
    Wend

Answer 1

Я предполагаю, что ваши Implicit листовые ссылки могут быть виновником. Как упоминалось в моем комментарии, Implicit ссылки будут ссылаться на текущий активный лист, или ActiveSheet.

Посмотрите этот пост о том, как этого избежать. Когда вы изучали этот пост, у вас должно быть Worksheet переменных, например, ws для ссылки.

Прямо сейчас, If Cells(iRow, "F") = Cells(aRow, "F") And Cells(iRow, "G") = Cells(aRow, "G") And Cells(iRow, "H") = Cells(aRow, "H") Then может быть TRUE в любом ActiveSheet со всеми пустыми ячейками. например. Таким образом, вы никогда не нажмете FALSE и iRow никогда увеличится> Бесконечно l oop> Ваша ошибка !