조건이 만족되면 코드 스틸 루프가 발생합니다.

Question

아래 코드에서 조건이 충족되는 경우에도 루프가 계속 반복됩니다. 줄 단위로 실행하고 처음에 루프를 실행하면 J300에서 셀 선택이 시작되는 위치를 볼 수 있으며 열을 아래로 이동하면서 선택 영역을 볼 수 있지만 조건이 충족되는 셀에 도달하면 선택 영역은 더 이상 상쇄되지 않지만 코드는 계속 반복되며 다음 줄로 이동하지 않습니다. 나는 무엇을 잘못하고 무엇을 더 잘 만들 수 있습니까? 당신의 도움을 주셔서 감사합니다.

Sub RollForwardDataImport() 
Dim rcell5, rcell6, rcell7, rcell8, rcell9 As Long 
    rcell8 = 0 
    rcell5 = Range("F2").Value 
    rcell9 = Range("F2").Value 
    Workbooks.Open "\\Inventory\CA-2016.xlsx" 
    Worksheets("Total Year").Activate 
    Range("J300").Select 

    Do While Selection.Value <> recell5 
    If Selection.Value = rcell5 Then 
     ActiveCell.Offset(0, 0).Select 
    Else: ActiveCell.Offset(1, 0).Select 
    End If 
    Loop 
    ActiveCell.Offset(0, -2).Select 
    rcell6 = Selection.Value 
    ActiveCell.Offset(0, -4).Select 
    rcell7 = Selection.Value 
    rcell8 = rcell6 + rcell7 + rcell8 

    Workbooks("Import.xlsm").Activate 
    Range("H20").Select 
    ActiveCell.Value = rcell8 
    Workbooks("CA-2016.xlsx").Close SaveChanges:=False 
End Sub 

Answer 1

다음은 코드의 수정 버전입니다. .Select/.Activate을 사용하지 않고 범위를 통해 루프를 사용하여 값을 찾습니다.

코드가 작동하는 방식을 확인하려면 F8으로 진행하는 것이 좋습니다.

Option Explicit 
Sub RollForwardDataImport() 
Dim rcell5 As Date, rcell6 As Long, rcell7 As Long, rcell8 As Long, rcell9 As String 
rcell8 = 0 
rcell5 = 11/1/2016 'Range("F2").Value 
rcell9 = Range("F2").Value 

Workbooks.Open "\\Inventory\CA-2016.xlsx" 

Dim myRng As Range, cel As Range 

With Worksheets("Total Year") 
    Set myRng = Range("J300:J1000") 'change this to your need. May be farther than row 1000 

    For Each cel In myRng 
     If cel.Value = rcell5 And Month(cel.Vlaue) = Month(rcell5) Then 
      rcell6 = cel.Offset(0, -2).Value 
      rcell7 = cel.Offset(0, -4).Value 
      rcell8 = rcell6 + rcell7 + rcell8 
      rcell5 = rcell5 + 
      Exit For 
     Else 
      rcell5 = cell.Offset(1,0).Value 
     End If 
    Next cel 
End With 

With Workbooks("Import.xlsm") 
    .Range("H20").Value = rcell8 
End With 

Workbooks("CA-2016.xlsx").Close SaveChanges:=False 
End Sub 

원하는대로 작동해야하지만, 놓친 것 같습니다. 그렇다면 알려주세요.