- Katılım
- 6 Kasım 2023
- Mesajlar
- 1
- Excel Vers. ve Dili
- Türkçe
Şöyle bir VBA koduna ihtiyacım var "Giris" Sayfası D1
125 aralığına nöbetçileri sırayla yereştireceğim.
I2:I100 arlığına şimdilik sadece 20 nöbetçi yazdım. Bunları yerleştireceğim.
I1:I100 aralığına yazdığım bu nöbetçileri D1
125 aralığına sırayla yerleştirmeliyim.
Hesapladığımda her nöbetçiye yaklaşık 7 nöbet Düşüyor. '=YUKARIYUVARLA(125/20;0) Yani her nöbetçi 6 defa nöbet tutacak.
Diğer bir ifadeyle, D1
125 aralığına ismi 7 defa yazılacak.
Bazı nöbetçilerin Özel Durumu vardır. Bunlar belirttiğim yerlerde nöbet tutmayacak.
Bu amaçla şöyle bir tablo hazırladım. I2:I100 aralığına Nöbetçilerin ismini listeledim
J1:AZ1 aralığına "Nöbet Yerleri" ni yazdım.
Bu tablonun satır ve sütularının kesiştiği bazı yerlere 1 işareti koydum.
Mesela "Ali" isimli nöbetçi ile "Ön Bahçe" isimli nöbet yerinin kesiştiği yere 1 yazdım.
Böylelikle Ali'ye Ön Bahçede nöbet yazılmasını engellemek istiyorum.
Özel durumu olan bu nöbetçilerin nöbet yeri kısıtlamasını bu şekilde yaptım.
I2:I00 aralığındaki Özel durumu olan nöbetçiler, D1
125 aralığına bu şekilde yerleştikten sonra, Diğer normal durumlu nöbetçilerin yerleştirilmesine başlanacak. Onlar da aynı şekilde sırayla yerleşecekler.
Yerleşirken, daha önce yerleşmiş olan Özel durumu olan Nöbetçileri silmeyecek. Onları atlayacak.
Bu amaçla Aşağıdaki kodu hazırladım. "Hata 400" iletisi veriyor
Sub NöbetYerleri()
Dim ws As Worksheet
Dim nöbetçiListesi As Range, nöbetYeriListesi As Range, hücre As Range
Dim sonNöbetçiSatır As Integer, i As Integer, j As Integer
Dim nöbetçi As String, nöbetYeri As String
Dim nöbetYerleriTablosu As Range
Set ws = ThisWorkbook.Sheets("Giris")
Set nöbetçiListesi = ws.Range("I2:I100")
Set nöbetYeriListesi = ws.Range("J1:W1")
Set nöbetYerleriTablosu = ws.Range("J2:W100")
sonNöbetçiSatır = 125
For i = 1 To nöbetçiListesi.Rows.count
nöbetçi = nöbetçiListesi.Cells(i, 9).Value
If Not (nöbetçiDurumu(nöbetçi, ws, nöbetYerleriTablosu)) Then
For j = 1 To sonNöbetçiSatır Step 7
Set hücre = ws.Range("D" & j).End(xlDown).offset(1, 0)
If hücre.offset(0, -1).Value <> ws.Range("C" & hücre.Row).Value Then
hücre.Value = nöbetçi
End If
Next j
End If
Next i
End Sub
Function nöbetçiDurumu(ByVal nöbetçiAdı As String, ByVal ws As Worksheet, ByVal nöbetYerleriTablosu As Range) As Boolean
Dim nöbetçi As Range, nöbetYeri As Range
For Each nöbetçi In ws.Range("I2:I100")
If nöbetçi.Value = nöbetçiAdı Then
For Each nöbetYeri In nöbetYerleriTablosu
If nöbetYeri.Value = 1 And ws.Cells(nöbetçi.Row, nöbetYeri.Column).Value = 1 Then
nöbetçiDurumu = True
Exit Function
End If
Next nöbetYeri
End If
Next nöbetçi
nöbetçiDurumu = False
End Function
I2:I100 arlığına şimdilik sadece 20 nöbetçi yazdım. Bunları yerleştireceğim.
I1:I100 aralığına yazdığım bu nöbetçileri D1
Hesapladığımda her nöbetçiye yaklaşık 7 nöbet Düşüyor. '=YUKARIYUVARLA(125/20;0) Yani her nöbetçi 6 defa nöbet tutacak.
Diğer bir ifadeyle, D1
Bazı nöbetçilerin Özel Durumu vardır. Bunlar belirttiğim yerlerde nöbet tutmayacak.
Bu amaçla şöyle bir tablo hazırladım. I2:I100 aralığına Nöbetçilerin ismini listeledim
J1:AZ1 aralığına "Nöbet Yerleri" ni yazdım.
Bu tablonun satır ve sütularının kesiştiği bazı yerlere 1 işareti koydum.
Mesela "Ali" isimli nöbetçi ile "Ön Bahçe" isimli nöbet yerinin kesiştiği yere 1 yazdım.
Böylelikle Ali'ye Ön Bahçede nöbet yazılmasını engellemek istiyorum.
Özel durumu olan bu nöbetçilerin nöbet yeri kısıtlamasını bu şekilde yaptım.
I2:I00 aralığındaki Özel durumu olan nöbetçiler, D1
Yerleşirken, daha önce yerleşmiş olan Özel durumu olan Nöbetçileri silmeyecek. Onları atlayacak.
Bu amaçla Aşağıdaki kodu hazırladım. "Hata 400" iletisi veriyor
Sub NöbetYerleri()
Dim ws As Worksheet
Dim nöbetçiListesi As Range, nöbetYeriListesi As Range, hücre As Range
Dim sonNöbetçiSatır As Integer, i As Integer, j As Integer
Dim nöbetçi As String, nöbetYeri As String
Dim nöbetYerleriTablosu As Range
Set ws = ThisWorkbook.Sheets("Giris")
Set nöbetçiListesi = ws.Range("I2:I100")
Set nöbetYeriListesi = ws.Range("J1:W1")
Set nöbetYerleriTablosu = ws.Range("J2:W100")
sonNöbetçiSatır = 125
For i = 1 To nöbetçiListesi.Rows.count
nöbetçi = nöbetçiListesi.Cells(i, 9).Value
If Not (nöbetçiDurumu(nöbetçi, ws, nöbetYerleriTablosu)) Then
For j = 1 To sonNöbetçiSatır Step 7
Set hücre = ws.Range("D" & j).End(xlDown).offset(1, 0)
If hücre.offset(0, -1).Value <> ws.Range("C" & hücre.Row).Value Then
hücre.Value = nöbetçi
End If
Next j
End If
Next i
End Sub
Function nöbetçiDurumu(ByVal nöbetçiAdı As String, ByVal ws As Worksheet, ByVal nöbetYerleriTablosu As Range) As Boolean
Dim nöbetçi As Range, nöbetYeri As Range
For Each nöbetçi In ws.Range("I2:I100")
If nöbetçi.Value = nöbetçiAdı Then
For Each nöbetYeri In nöbetYerleriTablosu
If nöbetYeri.Value = 1 And ws.Cells(nöbetçi.Row, nöbetYeri.Column).Value = 1 Then
nöbetçiDurumu = True
Exit Function
End If
Next nöbetYeri
End If
Next nöbetçi
nöbetçiDurumu = False
End Function