• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

for_next

  • Konbuyu başlatan Konbuyu başlatan hoguz2
  • Başlangıç tarihi Başlangıç tarihi
Katılım
6 Ekim 2004
Mesajlar
250
Excel Vers. ve Dili
MSOffice 2010 TR
Arkadaslar merhaba asagidaki kodu 1000 satira uygulamak istiyorum for next dongusunu nasil yazacagimi anlayamadim.


Sub hesapla()




If Cells(2, 6) <= 300 And Cells(2, 8) <= 1500 And Cells(2, 10) <= 500 Then
Cells(2, 4) = "EKO"

End If




End Sub
 
Merhaba
Bunu mu yapmaya çalışıyorsunuz?
Sub hesapla()
dim i as integer

for i=2 to 1000

If Cells(i, 6) <= 300 And Cells(i, 8) <= 1500 And Cells(i, 10) <= 500 Then
Cells(i, 4) = "EKO"

End If
next i

End Sub
 
Arkadaslar merhaba asagidaki kodu 1000 satira uygulamak istiyorum for next dongusunu nasil yazacagimi anlayamadim.


Sub hesapla()

If Cells(2, 6) <= 300 And Cells(2, 8) <= 1500 And Cells(2, 10) <= 500 Then
Cells(2, 4) = "EKO"
End If
End Sub

Merhaba.
Sn.hoguz2
Küçük bir örnek dosya eklerseniz..! Döngünün yanında; "Select Case" yöntemi işinizi daha kolaylaştıracak gibi
görünüyor.
 
Sn mersilen ve husquvarna ilginize tesekkur ederim.

evet for nex dogru ben insanlarin cok vaktini almamak icin biraz uzun yoldan da olsa halledebilirim diye aklima gelen en basit sekliyle sormustum bir iki degisik calisma kitabinda for nexti calistirip en son haline ulasacaktim fakat husquvarna haklisiniz is case sanirim daha profosyonel bir cozum olabilir ornek dosya ekliyorum bir tane is cafe makrosu vardi ama onu nasil kendime uyarlayacagimi da bilemedigim icin boyle sormustum

yapmak istedigim sayfa birde kriterler var kriterlere uygun tarifenin ismini numaranın yanına yazdirmak
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo ws_exit:
Set rng = Application.Intersect(Target, Me.Range("a:a"))

'("a:a")) bu a:a sütununu belirtir. Bunu değiştirirerek istenilen alana uygulayabiliriz.

If rng Is Nothing Then Exit Sub
With Target
Select Case LCase(.Value)

'Select Case LCase(.Value) küçük harfe duyarlı.
'Select Case UCase(.Value) büyük harfe duyarlı.

'Burada "" içindeki rakamlar yerine sözcükler yazılabilir.
' = İşaretinden sonra yer alan sayılar renk indeksidir.

'.Interior.ColorIndex yerine .Font.ColorIndex kullanılark biçimlendirmeyi fonta göre yapmak mümkün.

Case Is = "1": .Interior.ColorIndex = 1
Case Is = "2": .Interior.ColorIndex = 2
Case Is = "3": .Interior.ColorIndex = 3
Case Is = "4": .Interior.ColorIndex = 4
Case Is = "5": .Interior.ColorIndex = 5
Case Is = "6": .Interior.ColorIndex = 6
Case Is = "7": .Interior.ColorIndex = 7
Case Is = "8": .Interior.ColorIndex = 6
Case Is = "9": .Interior.ColorIndex = 9
Case Is = "10": .Interior.ColorIndex = 10
Case Else
.Interior.ColorIndex = xlNone
End Select
End With
 
arkadaslar dosya nasil ekleniyor bulamadim ?
 
Arkadaslar kodlari kurcaladim ekleme cikarma yaptim asagidaki iki makroyu sirasiyla calistirdigimda isim hallolmus oluyor.

ilginize yardiminiza tesekkur ederim

Sub hesapla()
Dim i As Integer

For i = 2 To 1000

If Not Empty = Cells(i, 4) Then

GoTo sonsatir


sonsatir:

ElseIf Cells(i, 6) <= 300 And Cells(i, 8) <= 1500 And Cells(i, 10) <= 500 Then
Cells(i, 4) = "EKO"

End If
Next i

End Sub


Sub hesapla2()

Dim i As Integer

For i = 2 To 1000


If Not Empty = Cells(i, 4) Then

GoTo sonsatir


sonsatir:

ElseIf Cells(i, 6) > 500 Or Cells(i, 8) > 2000 Or Cells(i, 10) > 1000 Then


Cells(i, 4) = "STAR"

Else


Cells(i, 4) = "AVANTAJ"

End If
Next i

End Sub
 
Geri
Üst