If ..... Then kod kısaltma

[tamer42]

Merhaba,
aşağıdaki kodda;
IF satırınında 6 tane AND bağlacı mevcut, bu şekilde kod çok kullanışlı olmuyor,
bu satırı daha kısa olarak yazmanın bir yöntemi olabilir mi?

Teşekkürler, iyi akşamlar.

Dim WS As Worksheet
Dim arr As Variant
Dim LR As Long
Dim i As Long
Dim x As Double, k As Byte

 k = 2

    Set WS = ActiveSheet
    LR = WS.Cells(WS.Rows.Count, "B").End(xlUp).row
    arr = WS.Range("K2:M" & LR).Value
    
    deg1 = arr(1, 1)
    deg2 = arr(1, 2)
    deg3 = arr(1, 3)

For i = LBound(arr, 1) To UBound(arr, 1)

   If arr(i, 1) >= deg1 - k And arr(i, 1) <= deg1 + k _
                    And arr(i, 2) >= deg2 - k And arr(i, 2) <= deg2 _
                            And arr(i, 3) >= deg3 - k And arr(i, 3) <= deg3 + k Then
    
                   x = x + 1
    End If
Next i

 

[cems]

IF satırını daha kısa bir şekilde yazmanız mümkündür. Aşağıda, AND bağlayıcıları kullanmadan IF satırını nasıl kısaltabileceğiniz örneklendirilmiştir:
If deg1 - k <= arr(i, 1) <= deg1 + k And deg2 - k <= arr(i, 2) <= deg2 And deg3 - k <= arr(i, 3) <= deg3 + k Then x = x + 1 End If
Bu şekilde IF satırını daha kısa ve okunabilir hale getirebilirsiniz.
Deneyin

 

[tamer42]

IF satırını daha kısa bir şekilde yazmanız mümkündür. Aşağıda, AND bağlayıcıları kullanmadan IF satırını nasıl kısaltabileceğiniz örneklendirilmiştir:
If deg1 - k <= arr(i, 1) <= deg1 + k And deg2 - k <= arr(i, 2) <= deg2 And deg3 - k <= arr(i, 3) <= deg3 + k Then x = x + 1 End If
Bu şekilde IF satırını daha kısa ve okunabilir hale getirebilirsiniz.
Deneyin

Desteğiniz için teşekkürler,
iyi Çalışmalar

 

[yanginci34]

Hocam birde böyle denermisiniz.

Dim WS As Worksheet
Dim arr As Variant
Dim LR As Long
Dim i As Long
Dim ii As Long
Dim x As Double, k As Byte

 k = 2

    Set WS = ActiveSheet
    LR = WS.Cells(WS.Rows.Count, "B").End(xlUp).Row
    arr = WS.Range("K2:M" & LR).Value
    
    deg1 = arr(1, 1)
    deg2 = arr(1, 2)
    deg3 = arr(1, 3)

For i = LBound(arr, 1) To UBound(arr, 1)
For ii = 1 To 3
   If arr(i, ii) >= deg & ii - k And arr(i, ii) <= deg & ii + k Then
    
                   x = x + 1
    End If
Next ii
Next i