Excel - VBA : 셀 내용이 특정 값과 같으면 루프 루프

Question

루프를 실행할 때 더 많은 요인을 고려할 수 있도록 코드를 수정하려고합니다. 여기에 내가 지금까지 가지고있는 것은, 그것은 2 = 605 (2와 605 사이에서, 내 G 열의 값은 항상 "Makati City"와 동일하기 때문에) i = 2에서 605까지 실행되는 루프입니다.

이 루프에는 몇 가지 동작이 정의되어 있으며 정상적으로 작동합니다.

For i = 2 To lRowBldg 
Range("B" & i).Activate 

'try to find a match btwn active cell and one of the elements from parsed address 
    For Each cell In elementsListRange.Cells 
     If Match(ActiveCell.Value, cell.Value) Then 
     Range("K" & i).Value = Range("K" & i).Value + 13 
     Else 
     Range("K" & i).Value = Range("K" & i).Value + 0 
     End If 
     If Match(ActiveCell.Offset(0, 4).Value, cell.Value) Then 
     Range("K" & i).Value = Range("K" & i).Value + 8 
     Else 
     Range("K" & i).Value = Range("K" & i).Value + 0 
     End If 
    Next 

Next i 

하지만이 파일에 약간의 수정을 할 계획으로, 내 코드를 다시 생각해야합니다 여기 내 루프가 무엇을하고 있는지 보여주는 관련 코드입니다. 지금까지 필자는 한 도시에 대해서만이 파일을 가지고 있었기 때문에 기본적으로 첫 번째 값에서 마지막 값까지 반복 할 수있었습니다. 이제 더 많은 도시를 추가 할 계획입니다. 예를 들어 2에서 605 (Makati City), 606에서 900 (blabla City), 901에서 ... 등등.
"한 G 열에서 셀의 값에 대한 루프는 XXXXX 같다 (blabla시, 수, 마카티 시티가 될 수 무엇이든)"내가하려고 어떤

이 같은 것입니다
그리고 마카티 시티에 대해 언급하면, i = 2에서 605까지 반복 될 것입니다. blabla City라면 i = 606에서 900까지 반복 할 것입니다.

내 파일이 너무 길어질 수 있으므로 너무 많은 리소스를 사용하지 않는 방법으로이 작업을 수행하는 방법에 대해 알고 계십니까?

미리 감사드립니다.

Answer 1

잠시 사용 하시겠습니까? 다음을 수정

은 표준 모듈에있는 모든 코드를 넣어 : 여기 몇 가지 아이디어 ....

Sub Test() 
     dim rng as range 
     rng = worksheet.find 

     While rng.Value2 LIKE "Makhati City" 
     'your logic here 
     rng.offset(row+1,col+0 or like this) 
     Wend 
    End Sub 

Answer 2

당신이 완전히 루프를 피하고 열을 L & N, 및 를 사용하여이 작업을 시도 할 수있다

: setColumnKValues ​​ 코드는 G.에게 열에서 differenct cioy 이름을

가정을 검색 할 수 differencet 도시가 함께 그룹화됩니다

• 당신이 중간체 (이 경우 L & N에서) 추가 열 몇 가지를 사용할 수 있습니다
• 당신은에 도시의 순서로 setFormulasColumnK를 호출 할 것이다 시트
• 질문에있는 코드를 기반으로 조건이 충족 될 경우 열 K에 숫자를 추가하려고합니다.

작동합니까 방법 : 먼저, 우리가 일치하는 경우 도시, 우리는 공식에 넣어 열 L에서, 다음 을 변경 위치를 표시 마커 값을 넣어 열 N에 도시 후, L 전달 = 바로`each`은 아래, K + 13 마지막으로, 우리는 열 K의 새 값을 붙여 복사하고 명확한 열 L & N

Private oLastRange As Range 
Private iFirstCell As Integer 
Private iLastCell As Integer 
Private lLastRow As Long 

Sub setFormulasColumnK(ByVal sCity As String) 

Dim sFormula As String 
Dim oRange As Range 

lLastRow = Cells(Rows.Count, Range("G1").Column).End(xlUp).Row 

Range("N4:N" & lLastRow).Formula = "=IF(G4<>G5,NA(),"""")" 

If Not Range("G:G").Find(sCity) Is Nothing Then 
    iFirstCell = Range("G:G").Find(sCity).Row 
Else 
    Exit Sub 
End If 

Set oRange = Range("N" & iFirstCell) 

iLastCell = Range("N" & iFirstCell & ":N" & lLastRow).Find("#N/A", oRange).Row 

Range("L" & iFirstCell & ":L" & iLastCell).Formula = "=IF(TRIM(G:G)=""" & sCity & """,K:K+13,0)" 
Set oLastRange = Range("L" & iLastCell) 

End Sub 

Sub setColumnKValues() 

    Set oLastRange = Nothing 

    Call setFormulasColumnK("Makati City") 
    'MsgBox oLastRange.Address 
    Call setFormulasColumnK("London") 
    'MsgBox oLastRange.Address 
    Call setFormulasColumnK("Birmingham") 
    'MsgBox oLastRange.Address 
    Call setFormulasColumnK("Moscow") 
    'MsgBox oLastRange.Address 
    Call setFormulasColumnK("Luxembourg") 
    'MsgBox oLastRange.Address 
    Call setFormulasColumnK("Paris") 
    'MsgBox oLastRange.Address 

    Range("L4" & ":L" & lLastRow).Copy 
    Range("K4" & ":K" & lLastRow).PasteSpecial xlPasteValues 
    Range("N4:N" & lLastRow).Clear 
    Range("L4" & ":L" & lLastRow).Clear 

End Sub