Бесконечная петля при сборе наборов данных из нескольких листов

Question

Это мой первый код для кода в VBA. У меня есть несколько рабочих листов в файле, и они упорядочены по датам. Итак, я пытаюсь сделать сбор данных на листе, если они имеют одинаковый период времени.

date1 value1
date2 значение2
date3 value3

Поскольку они в порядке, я просто сравнить первые значения даты и если они различны он переходит к следующему листу. Если они совпадают, то скопируйте значение и выполните тот же процесс, пока он не достигнет последнего рабочего листа. Однако он копирует один рабочий лист, но после этого Excel замерзает.

Я был бы признателен, если вы обнаружите какие-либо ошибки или дадите мне другие предложения для этого.
Ниже мой код:

Sub matchingStock() 

Dim sh1 As Worksheet, sh2 As Worksheet 
' create short references to sheets 
' inside the Sheets() use either the tab number or name 
Set sh1 = Sheets("combined") 

Dim col As Long 

'since first column is for Tbill it stock price should place from the third column 
col = 3 

Dim k As Long 

'go through all the stock worksheets 
For k = Sheets("WLT").Index To Sheets("ARNA").Index 
    Set sh2 = Sheets(k) 

    ' Create iterators 
    Dim i As Long, j As Long 

    ' Create last rows values for the columns you will be comparing 
    Dim lr1 As Long, lr2 As Long 

    ' create a reference variable to the next available row 
    Dim nxtRow As Long 

    ' Create ranges to easily reference data 
    Dim rng1 As Range, rng2 As Range 

    ' Assign values to variables 
    lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row 
    lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row 

    If sh1.Range("A3").Value = sh2.Range("A3").Value Then 
     Application.ScreenUpdating = False 

     ' Loop through column A on sheet1 
     For i = 2 To lr1 
      Set rng1 = sh1.Range("A" & i) 

      ' Loop through column A on sheet1 
      For j = 2 To lr2 
       Set rng2 = sh2.Range("A" & j) 

       ' compare the words in column a on sheet1 with the words in column on sheet2 
       'Dim date1 As Date 
       'Dim date2 As Date 

       'date1 = TimeValue(sh1.Range("A3")) 
       'date2 = TimeValue(sh2.Range("A3")) 

       sh1.Cells(1, col).Value = sh2.Range("A1").Value 

       ' find next empty row 
       nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1 

       ' copy the word in column A on sheet2 to the next available row in sheet1 
       ' copy the value (offset(0,1) Column B) to the next available row in sheet1 
       sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value 

       'when the date is different skip to the next worksheet 
       Set rng2 = Nothing 
      Next j 
      Set rng1 = Nothing 
     Next i 
     'sh3.Rows("1:1").Delete 
     Else 
      GoTo Skip 
     End If 
Skip: 
col = col + 1 
Next k 
End Sub 

Answer 1

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

Предложение 1

Как вы думаете Else блок If-Then-Else-End-Если является обязательным?

If sh1.Range("A3").Value = sh2.Range("A3").Value Then 
    : 
    Else 
    GoTo Skip 
    End If 
Skip: 

так же, как:

If sh1.Range("A3").Value = sh2.Range("A3").Value Then 
    : 
    End If 

внушения 2

мне не нравится:

For k = Sheets("WLT").Index To Sheets("ARNA").Index 

Значение индекса для листа может не то, что вы думаете, что это так. Это может не дать вам набор или последовательность рабочих листов, которые вы ожидаете. Вам нужен каждый лист, кроме «Комбинированный»? Следующие должны быть более надежными:

For k = 1 To Worksheets.Count 
    If Worksheets(k).Name <> sh1.Name Then 
    : 
    End If 
Next 

Предложение 3

Вы используете:

.Range("A" & Rows.Count) 
.Range("A3") 
.Cells(1, col).Value 
.Cells(Rows.Count, col) 
rng2.Offset(0, 6) 

Все эти методы идентификации клетки или диапазона имеют свои цели. Тем не менее, я сбиваю с толку использование более чем одного за раз. Я считаю, что .Cells(row, column) и .Range(.Cells(row1, column1), .Cells(row2, column2)) являются самыми универсальными и используют их, если нет веской причины использовать один из других методов.

Предложение 4

Я не могу декодировать, что этот код пытается достичь.

Вы говорите: «У меня есть несколько рабочих листов в файле, и они упорядочены по датам. Поэтому я пытаюсь собрать наборы данных в листе, если они имеют одинаковый период времени."

Если вы установили Worksheet("combined").Range("A3").Value на конкретную дату и хотите собирать данные со всех этих листов с тем же значением в ячейке A3, тогда внешние For-Loop и If дают этот эффект. Но если да, неважно, как упорядочиваются рабочие листы. Также вы начинаете проверять значения ячеек из строки 2, которые предполагают, что строка 3 является регулярной строкой данных.

Внешний цикл для каждого листа, следующий цикл для каждой строки в "комбинированном" и внутренняя петля для каждой строки на листе, выбранном внешним контуром. Средний цикл не работает ничего, кроме установленного rng1, который не используется.

Возможно, вы n добавьте объяснение того, чего вы пытаетесь достичь.

Предложение 5

Вы пытаетесь добавить целый столбец значений из исходных рабочих листов к «Комбинированный». Макросъемки ниже:

• Определяет следующую свободную строку в колонке А «Комбинированный»
• Определяет последнюю использованную строку в колонке А «Лист2» ​​
• подставит первую интересную строку «Лист2» ​​является 2.
• Добавляет весь использованный диапазон столбца A «Sheet2» (в комплекте с форматированием) в конец столбца «Комбинированный» A в одном заявлении.

Это может продемонстрировать лучший способ достижения эффекта, который вы ищете.

Sub Test() 

    Dim RngSrc As Range 
    Dim RngDest As Range 
    Dim RowCombNext As Long 
    Dim RowSrcFirst As Long 
    Dim RowSrcLast As Long 

    With Worksheets("Combined") 
    RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1 
    Set RngDest = .Cells(RowCombNext, "A") 
    End With 

    With Worksheets("Sheet2") 
    RowSrcFirst = 2 
    RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row 
    Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A")) 
    End With 

    RngSrc.Copy Destination:=RngDest 

End Sub