Döngü oluşturma

[aliakgul]

Private Sub CommandButton2_Click()
a = Range("d8") 'e8,f8,gh............ah8'e kadar
b = Range("d7") 'e8,f8,gh............ah8'e kadar
c = Range("aj2")
'//////////////////////////////
'Bu aradakiler sabit...
g1 = Sheets("liste").Range("e2:e26").Value
g2 = Sheets("liste").Range("f2:f26").Value
g3 = Sheets("liste").Range("g2:g26").Value
g4 = Sheets("liste").Range("h2:h26").Value
g5 = Sheets("liste").Range("ı2:ı26").Value
Range("d36").Value = Date
Range("aj2").Value = Month(Date)
Range("d9:ah33").Value = ""
'/////////////////////////////
If a = 1 Then
Sheets("ekders").Range("d9:d33").Value = g1  'bu satırlardaki ("D9:D33")lerdeki D'lerin de
End If                                       'değişken olması gerekiyor. d9:d33, e9:e33, f9:f33.......ah9:ah33 şekilde.
If a = 2 Then
Sheets("ekders").Range("d9:d33").Value = g2
End If
If a = 3 Then
Sheets("ekders").Range("d9:d33").Value = g3
End If
If a = 4 Then
Sheets("ekders").Range("d9:d33").Value = g4
End If
If a = 5 Then
 Sheets("ekders").Range("d9:d33").Value = g5
End If
If a < 1 Or a > 5 Or b > c Then
Sheets("ekders").Range("d9:d33").Value = "X"
End If
End Sub

Merhaba arkadaşlar,
Yeni bir düzenleme yaptım ve tabir yerindeyse zurnanın zırt dediği yere geldim.
Kodların içinde sabitleri belittim zaten..Burada D8 ve D7'nin durumuna göre D9:d33 aralığında bir uygulama yapıyor.
Benim yapmak istediğim;
Düğmeye tıklayınca ( ya da çalışma kitabını açınca ) bu düzenlemeyi, sadece D sütununda değil, D:AH aralığındaki sütunlarda gerçekleştirsin...
(e7 ve e8'in durumuna göre E9:E33, F7 ve F8'in durumuna göre F9:f33......diye devam edecek)
Herkese kolay gelsin.....

 

[veyselemre]

[vb:1:07df7eb3a2]Private Sub CommandButton2_Click()

Dim g(5)
Set sL = Sheets("LİSTE")

For i = 1 To 5
g(i) = sL.Range(sL.Cells(2, i + 4), sL.Cells(26, i + 4)).Value
Next

[d9:ah33].ClearContents

Range("d36").Value = Date
Range("aj2").Value = Month(Date)

c = Range("aj2")

For x = 4 To 34
b = Cells(7, x)
hgun = Cells(8, x)

If hgun >= 1 And hgun <= 5 And b = c Then
Range(Cells(9, x), Cells(33, x)).Value = g(hgun)
Else
Range(Cells(9, x), Cells(33, x)).Value = "X"
End If

Next x

End Sub[/vb:1:07df7eb3a2]

 

[aliakgul]

Sn. veyselemre,
Hani derler ya;
"Kul daralmayınca Hızır yetişmez..."
Benimki de tam öyle oldu işte. Allah razı olsun.Çok güzel bir çalışma oldu sayende.. :hey:

 

[aliakgul]

[No message]

 

[aliakgul]

Selam,
Ya bana birşeyler oluyor, ya da benim bilgisayara...Dün gece buraya teşekkür mesajı yazdığımı çok iyi hatırlıyorum. :yazici: Ama şimdi baktım, yok.... :hayir:
Mesajımı kaybettim, hükümsüzdür...
Sn. veyselemre,
"Kul daralmazsa Hızır yetişmezmiş, derler demiştim. Evet aynen öyle oldu...Sayende çok verimli ve güzel bir çalışmanın son ayağı da tamamlandı.Eline, yüreğine sağlık... :bravo: :bravo: :bravo:
Not: Şu benim mesaja bir yerlerde raslarsanız, lütfen bana da haber verin... :kafa: