TURKOLOG
Altın Üye
- Katılım
- 13 Kasım 2008
- Mesajlar
- 744
- Excel Vers. ve Dili
- 2016 64 TR
- Altın Üyelik Bitiş Tarihi
- 29-10-2026
Herkese Merhaba aşağıdaki kodda şöyle bir hata var ve düzeltemiyorum.
Görev listesi sayfası C4:I19 sayfasındaki veriyi temizlemesi gerekirken C4:E19 arasında proplem yok ama F4:I sütünü aralığında B sütünü son dolu satıra kadar bakıyor ve F4:I son dolu satıra kadar temizliyor .
Olması gereken B sutunu dolu ise C4:I19 aralığını
temizlemeli.
Naptiysam olmadı Yardımcı olabilecek olan var mi?
Görev listesi sayfası C4:I19 sayfasındaki veriyi temizlemesi gerekirken C4:E19 arasında proplem yok ama F4:I sütünü aralığında B sütünü son dolu satıra kadar bakıyor ve F4:I son dolu satıra kadar temizliyor .
Olması gereken B sutunu dolu ise C4:I19 aralığını
temizlemeli.
Naptiysam olmadı Yardımcı olabilecek olan var mi?
Kod:
Sub Dortlu_Sistem()
Dim sG As Worksheet, sD As Worksheet, gorev()
Dim i&, ii&, krt$, w(1 To 1, 1 To 4)
Set sG = Sheets("GÖREV LİSTESİ")
Set sD = Sheets("4LÜ_DATA")
sG.Range("C4:I19").ClearContents
gorev = Array("Gündüz Çalışan", "Gece Çalışan", "Geceden Çıkıp İstirahatli", "Gündüzden Çıkıp İstirahatli")
With CreateObject("Scripting.Dictionary")
For i = 2 To sD.Cells(Rows.Count, "F").End(3).Row
w(1, 1) = "": w(1, 2) = "": w(1, 3) = "": w(1, 4) = ""
krt = sD.Cells(i, "B").Value
For ii = 3 To 6
Select Case sD.Cells(i, ii).Value
Case "1. GRUP": w(1, 1) = gorev(ii - 3)
Case "2. GRUP": w(1, 2) = gorev(ii - 3)
Case "3. GRUP": w(1, 3) = gorev(ii - 3)
Case "4. GRUP": w(1, 4) = gorev(ii - 3)
End Select
Next ii
.Item(krt) = w
Next i
For i = 4 To sG.Cells(Rows.Count, "B").End(3).Row
krt = sG.Cells(i, "B").Value
If .exists(krt) Then sG.Cells(i, 6).Resize(i, 4).Value = .Item(krt)
Next i
End With
End Sub