Kalansız Bölme

ahmed_ummu · 15 Ocak 2023

İyi akşamlar arkadaşlar.

Ektediğim örnek dosyada "üo" sayfasındaki kırmızı renkli satırın da sonucu 4 çıkması gerekiyor. Diğer sonuçlar doğru. Nerede yanlış var yardımcı olabilir misiniz.
Veri sayfasındaki "C" sütununu son dolu satıra kadar kontrol edip, eğer bu değerler "parametreler" sayfası "A" sütununda var ise "üo" sayfasındaki "G" sütunu daki veriyi kalansız 7 ye bölüp, "h" sütununa yazacak. "üo" sayfasındaki "J" sütunundaki veriler herhangi bir işleve etkisi olmuuyor.

ahmed_ummu · 15 Ocak 2023

Birinci satırdan itibaren son dolu satıra kadar döngü olması gerekmiyor mu? Sanırsam sadece son satırı dikkate alıyor.

halit3 · 15 Ocak 2023

Kurgu da bir hata var gibi
Bu kodu denermisiniz.
parametreler sayfasında yazılı olanlardan ("OKUL MÜDÜRÜ", "MÜDÜR YARDIMCISI" , "REHBER ÖĞRETMENİ" )4 olacak diğerleri 3 olacak yazılı olmayanlar ise boş olacak

Kod:

Private Sub CommandButton1_Click()

Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")

For i = 1 To sh1.Cells(Rows.Count, 2).End(xlUp).Row
If sh1.Cells(i, 4).Value = "HESAPLANSIN" Then
aranan = sh1.Cells(i, 3).Value
If sh1.Cells(i, 3).Value = "OKUL MÜDÜRÜ" Or sh1.Cells(i, 3).Value = "MÜDÜR YARDIMCISI" Or sh1.Cells(i, 3).Value = "REHBER ÖĞRETMENİ" Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 7)
Else
For k = 1 To sh3.Cells(Rows.Count, 1).End(xlUp).Row
bulunan = sh3.Cells(k, 1).Value
If aranan = bulunan Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 10)
Exit For
End If
Next k
End If
End If
Next i

End Sub

ahmed_ummu · 15 Ocak 2023

halit3' Alıntı:

Kurgu da bir hata var gibi
Bu kodu denermisiniz.
parametreler sayfasında yazılı olanlardan ("OKUL MÜDÜRÜ", "MÜDÜR YARDIMCISI" , "REHBER ÖĞRETMENİ" )4 olacak diğerleri 3 olacak yazılı olmayanlar ise boş olacak

Kod:

Private Sub CommandButton1_Click()

Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")

For i = 1 To sh1.Cells(Rows.Count, 2).End(xlUp).Row
If sh1.Cells(i, 4).Value = "HESAPLANSIN" Then
aranan = sh1.Cells(i, 3).Value
If sh1.Cells(i, 3).Value = "OKUL MÜDÜRÜ" Or sh1.Cells(i, 3).Value = "MÜDÜR YARDIMCISI" Or sh1.Cells(i, 3).Value = "REHBER ÖĞRETMENİ" Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 7)
Else
For k = 1 To sh3.Cells(Rows.Count, 1).End(xlUp).Row
bulunan = sh3.Cells(k, 1).Value
If aranan = bulunan Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 10)
Exit For
End If
Next k
End If
End If
Next i

End Sub

Teşekkürler Halit bey.

Aslında şu olacak. parametreler sayfasının "A" sütununda hangi branşlar var ise "üo" sayfasının "G" sütunundaki değerleri kalansız 7'ye bölecek. Parametreler sayfasının "A" olmayanları kalansız 10'a bölecek.

Aynı şey parametreler sayfasının B sütununda bulunanlar içinde olacak. Eğer parametreler sayfası B sütununda olan branş var ise o satırdaki seğeri bölmeyecek. boş bırakacak.

Benim örnek dosyamda parametreler sayfasında A sütunu 1 satırdan son dolu satıra kadar olan döngüde bir hata var. Hep son satırdaki değer ile işlem yapıyor. Parametreler sayfası A sütunu da branşların yerlerini değiştirince yine son satırdaki branşı dikkate alıyor.

halit3 · 15 Ocak 2023

kod

Kod:

Private Sub CommandButton1_Click()

Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")

For i = 1 To sh2.Cells(Rows.Count, 10).End(xlUp).Row
If sh1.Cells(i, 4).Value = "HESAPLANSIN" Then
aranan = sh2.Cells(i, 10).Value

For k = 1 To sh3.Cells(Rows.Count, 1).End(xlUp).Row
bulunan = sh3.Cells(k, 1).Value
If aranan = bulunan Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 7)
Exit For
End If
Next k

For k = 1 To sh3.Cells(Rows.Count, 2).End(xlUp).Row
bulunan2 = sh3.Cells(k, 2).Value
If aranan = bulunan2 Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 10)
Exit For
End If
Next k

End If

Next i

End Sub

ahmed_ummu · 15 Ocak 2023

halit3' Alıntı:

kod

Kod:

Private Sub CommandButton1_Click()

Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")

For i = 1 To sh2.Cells(Rows.Count, 10).End(xlUp).Row
If sh1.Cells(i, 4).Value = "HESAPLANSIN" Then
aranan = sh2.Cells(i, 10).Value

For k = 1 To sh3.Cells(Rows.Count, 1).End(xlUp).Row
bulunan = sh3.Cells(k, 1).Value
If aranan = bulunan Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 7)
Exit For
End If
Next k

For k = 1 To sh3.Cells(Rows.Count, 2).End(xlUp).Row
bulunan2 = sh3.Cells(k, 2).Value
If aranan = bulunan2 Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 10)
Exit For
End If
Next k

End If

Next i

End Sub

Çok teşekürler Halit bey. Son gönderdiğiniz kodlar aşağıdaki şekilde (kırmızı renkli kod astırları) gibi revize edilince düzeldi.

Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")

For i = 1 To sh2.Cells(Rows.Count, 10).End(xlUp).Row
If sh1.Cells(i, 4).Value = "HESAPLANSIN" Then
aranan = sh2.Cells(i, 10).Value

For k = 1 To sh3.Cells(Rows.Count, 1).End(xlUp).Row
bulunan = sh3.Cells(k, 1).Value
If aranan = bulunan Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 7)
Exit For
Else
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 10)
End If

Next k

For k = 1 To sh3.Cells(Rows.Count, 2).End(xlUp).Row
bulunan2 = sh3.Cells(k, 2).Value
If aranan = bulunan2 Then
sh2.Cells(i, 8).Value = ""
Exit For
End If
Next k

End If

Next i

ahmed_ummu · 15 Ocak 2023

halit3' Alıntı:

kod

Kod:

Private Sub CommandButton1_Click()

Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")

For i = 1 To sh2.Cells(Rows.Count, 10).End(xlUp).Row
If sh1.Cells(i, 4).Value = "HESAPLANSIN" Then
aranan = sh2.Cells(i, 10).Value

For k = 1 To sh3.Cells(Rows.Count, 1).End(xlUp).Row
bulunan = sh3.Cells(k, 1).Value
If aranan = bulunan Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 7)
Exit For
End If
Next k

For k = 1 To sh3.Cells(Rows.Count, 2).End(xlUp).Row
bulunan2 = sh3.Cells(k, 2).Value
If aranan = bulunan2 Then
sh2.Cells(i, 8).Value = Fix(sh2.Cells(i, 7).Value / 10)
Exit For
End If
Next k

End If

Next i

End Sub

Merhaba Halit bey. Örnek dosyadaki kodları kendi doyama uyarladım ama kırmızı renkli olan satırda Type mismatch hatası veriyor. Örnek dosyada düzgün çalışıyor. Kendi dosyamı ekledim. Kodlar Userform25 de bulunan Commandbutton3'ün içinde.

Veri sayfasının 7 sütunu "G" sütunu parametreler sayfası H" sütununda var ise "ÜO" sayfasındaki 7 sütunundaki "G" sütunundaki veriyi, yine ÜO sayfasının "S" sütununa 19 sütununa kalansız 7 ye bölecek. Eğer Veri sayfasının 7 sütunu "G" sütunu parametreler sayfası H" sütununda yok ise "ÜO" sayfasındaki 7 sütunundaki "G" sütunundaki veriyi, yine ÜO sayfasının "S" sütununa 19 sütununa kalansız 10 a bölecek.

Aynı şey paramertreler sayfasının 9 sütunu "I" sütunu içinde uygulanacak. Burada herhangi bölme işlemi yapılmayıp boş "" bırakılacak. Yardımcı olursanız çok sevinirim.

For ii = 1 To sh1.Cells(Rows.Count, 7).End(xlUp).Row
If sh1.Cells(ii, 40).Value = "HESAPLANSIN" Then
aranan = sh1.Cells(ii, 7).Value

For k = 1 To sh3.Cells(Rows.Count, 8).End(xlUp).Row
bulunan = sh3.Cells(k, 8).Value
If aranan = bulunan Then
sh2.Cells(ii, 19).Value = Fix(sh2.Cells(ii, 7).Value / 7)
Exit For
Else
sh2.Cells(ii, 19).Value = Fix(sh2.Cells(ii, 7).Value / 10)
End If
Next k
For k = 1 To sh3.Cells(Rows.Count, 9).End(xlUp).Row
bulunan2 = sh3.Cells(k, 9).Value '
If aranan = bulunan2 Then
sh2.Cells(ii, 19).Value = ""
Exit For
End If
Next k
End If
Next ii

halit3 · 15 Ocak 2023

kodda sayfa ismi (üo) yazıyor ama dosyadaki sayfa ismi (ÜO) yazıyor
ÜO sayfasısının (sh2.Cells(ii, 7).Value) yedinci sütununda deger sayı (30) yok olduğundan kod duruyor.

halit3 · 15 Ocak 2023

Kodun bu bölümlerine +9 ekle

Rich (BB code):

sh2.Cells(ii+9, 19).Value = Fix(sh2.Cells(ii, 7).Value / 7)
Exit For
Else
sh2.Cells(ii + 9, 19).Value = Fix(sh2.Cells(ii + 9, 7).Value / 10) ' BU SATIR HATA VERİYOR
End If
Next k
For k = 1 To sh3.Cells(Rows.Count, 9).End(xlUp).Row
bulunan2 = sh3.Cells(k, 9).Value    '
If aranan = bulunan2 Then
sh2.Cells(ii + 9, 19).Value = ""

ahmed_ummu · 15 Ocak 2023

halit3' Alıntı:

Kodun bu bölümlerine +9 ekle

Rich (BB code):

sh2.Cells(ii+9, 19).Value = Fix(sh2.Cells(ii, 7).Value / 7)
Exit For
Else
sh2.Cells(ii + 9, 19).Value = Fix(sh2.Cells(ii + 9, 7).Value / 10) ' BU SATIR HATA VERİYOR
End If
Next k
For k = 1 To sh3.Cells(Rows.Count, 9).End(xlUp).Row
bulunan2 = sh3.Cells(k, 9).Value    '
If aranan = bulunan2 Then
sh2.Cells(ii + 9, 19).Value = ""

Halit bey kodlar için teşekkürler. Sonuç bazıları doğru ama bazıları yanlış çıkıyor. Ekte sonucun yazıldığı örnek sayfayı gönderdim.

halit3 · 15 Ocak 2023

Kod da döngünün biri fazla

Kod:

Private Sub CommandButton3_Click()
If TextBox7.Value = "" Then
MsgBox ("Ücret onayının Başlangıç tarihini giriniz..."), vbQuestion, "Uyarı"
TextBox7.SetFocus
Else

With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With


Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")
'sh2.Range("A5:F65000").ClearContents
SonSatirsil = sh2.Cells(Rows.Count, "b").End(3).Row + 45
sh2.Rows("10:" & SonSatirsil).Delete

s = 10

For i = 2 To sh1.Cells(Rows.Count, 2).End(xlUp).Row
If sh1.Cells(i, 40).Value = "HESAPLANSIN" Then
sh2.Range("B" & s).Value = sh1.Cells(i, 2).Value  'ADI
sh2.Range("C" & s).Value = sh1.Cells(i, 3).Value  'tC NO
sh2.Range("D" & s).Value = sh1.Cells(i, 16).Value  'GÖREVİ
sh2.Range("E" & s).Value = sh1.Cells(i, 7).Value  'BRANŞI
sh2.Range("F" & s).Value = sh1.Cells(i, 171).Value  'AYLIK KARŞILIĞI
sh2.Range("G" & s).Value = sh1.Cells(i, 170).Value  'FİİLEN GİRDİĞ
sh2.Range("m" & s).Value = sh1.Cells(i, 170).Value  'toplam girdiği
sh2.Range("n" & s).Value = sh1.Cells(i, 174).Value  'yönetim görevi

If sh1.Cells(i, 7).Value = "OKUL MÜDÜRÜ" Or sh1.Cells(i, 7).Value = "MÜDÜR YARDIMCISI" Or sh1.Cells(i, 7).Value = "REHBER ÖĞRETMENİ" Then
sh2.Range("o" & s).Value = ""
Else
sh2.Range("o" & s).Value = sh2.Range("G" & s).Value - sh2.Range("F" & s).Value
End If

If sh1.Cells(i, 16).Value = "MÜDÜR" Or sh1.Cells(i, 16).Value = "MÜDÜR YARDIMCISI" Then
sh2.Range("q" & s).Value = sh1.Cells(i, 175).Value
Else
sh2.Range("q" & s).Value = ""
End If

If sh1.Cells(i, 16).Value = "ÖĞRETMEN" Or sh1.Cells(i, 16).Value = "UZMAN ÖĞRETMEN" Or sh1.Cells(i, 16).Value = "BAŞÖĞRETMEN" Then
sh2.Range("R" & s).Value = sh1.Cells(i, 175).Value
Else
sh2.Range("R" & s).Value = ""
End If

'HATA VEREN KOD BLOĞU
'-------------------------------------------------------------------------------------------------------------------------------


If sh1.Cells(i, 40).Value = "HESAPLANSIN" Then
aranan = sh1.Cells(i, 7).Value

'sh2.Cells(s, 19).Select


For k = 1 To sh3.Cells(Rows.Count, 8).End(xlUp).Row
bulunan = sh3.Cells(k, 8).Value
If aranan = bulunan Then
sh2.Cells(s, 19).Value = Fix(sh2.Cells(s, 7).Value / 7)
Exit For

Else
sh2.Cells(s, 19).Value = Fix(sh2.Cells(s, 7).Value / 10) ' BU SATIR HATA VERİYOR

End If
Next k

For k = 1 To sh3.Cells(Rows.Count, 9).End(xlUp).Row
bulunan2 = sh3.Cells(k, 9).Value    '
If aranan = bulunan2 Then
sh2.Cells(s, 19).Value = ""
Exit For
End If
Next k
End If

'-----------------------------------------------------------------------------------------------------------------------------

sh2.Range("t" & s).Value = sh1.Cells(i, 176).Value  'yönetim görevi
If sh1.Cells(i, 168).Value = "EVET" Then
sh2.Range("z" & s).Value = 2
Else
sh2.Range("z" & s).Value = ""
End If

sh2.Range("aa" & s).Value = sh2.Range("N" & s).Value + sh2.Range("O" & s).Value + sh2.Range("P" & s).Value + sh2.Range("Q" & s).Value + sh2.Range("R" & s).Value + sh2.Range("S" & s).Value + sh2.Range("T" & s).Value + sh2.Range("U" & s).Value + sh2.Range("V" & s).Value + sh2.Range("W" & s).Value + sh2.Range("X" & s).Value + sh2.Range("Y" & s).Value + sh2.Range("Z" & s).Value

s = s + 1
End If

Next i

'Sıra vnumarası veriliyor


For i1 = 10 To Range("b65000").End(3).Row
On Error Resume Next
If (Range("b" & i1).Value <> "") Then
Range("a" & i1) = i1 - 9
Range("a" & i1).Font.Size = 9
Range("a" & i1).HorizontalAlignment = xlCenter
End If
Next i1

'Kenarlk izimi
Dim m As Integer
    Dim Son As Long
    Son = sh2.Cells(Rows.Count, "B").End(3).Row
    For m = 1 To 4
        sh2.Range("A10:ah" & Son).Borders(m).LineStyle = 1  'Normal çizgiler çiziliyor
        sh2.Range("A10:ah" & Son).Font.Size = 9
        Next m
        

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
    

MsgBox ("Ücret onayı hazırlandı...")
CommandButton7.Enabled = True
CommandButton8.Enabled = True
CommandButton9.Enabled = True
End If
End Sub

ahmed_ummu · 15 Ocak 2023

halit3' Alıntı:

Kod da döngünün biri fazla

Kod:

Private Sub CommandButton3_Click()
If TextBox7.Value = "" Then
MsgBox ("Ücret onayının Başlangıç tarihini giriniz..."), vbQuestion, "Uyarı"
TextBox7.SetFocus
Else

With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With


Set sh1 = Sheets("veri")
Set sh2 = Sheets("üo")
Set sh3 = Sheets("parametreler")
'sh2.Range("A5:F65000").ClearContents
SonSatirsil = sh2.Cells(Rows.Count, "b").End(3).Row + 45
sh2.Rows("10:" & SonSatirsil).Delete

s = 10

For i = 2 To sh1.Cells(Rows.Count, 2).End(xlUp).Row
If sh1.Cells(i, 40).Value = "HESAPLANSIN" Then
sh2.Range("B" & s).Value = sh1.Cells(i, 2).Value  'ADI
sh2.Range("C" & s).Value = sh1.Cells(i, 3).Value  'tC NO
sh2.Range("D" & s).Value = sh1.Cells(i, 16).Value  'GÖREVİ
sh2.Range("E" & s).Value = sh1.Cells(i, 7).Value  'BRANŞI
sh2.Range("F" & s).Value = sh1.Cells(i, 171).Value  'AYLIK KARŞILIĞI
sh2.Range("G" & s).Value = sh1.Cells(i, 170).Value  'FİİLEN GİRDİĞ
sh2.Range("m" & s).Value = sh1.Cells(i, 170).Value  'toplam girdiği
sh2.Range("n" & s).Value = sh1.Cells(i, 174).Value  'yönetim görevi

If sh1.Cells(i, 7).Value = "OKUL MÜDÜRÜ" Or sh1.Cells(i, 7).Value = "MÜDÜR YARDIMCISI" Or sh1.Cells(i, 7).Value = "REHBER ÖĞRETMENİ" Then
sh2.Range("o" & s).Value = ""
Else
sh2.Range("o" & s).Value = sh2.Range("G" & s).Value - sh2.Range("F" & s).Value
End If

If sh1.Cells(i, 16).Value = "MÜDÜR" Or sh1.Cells(i, 16).Value = "MÜDÜR YARDIMCISI" Then
sh2.Range("q" & s).Value = sh1.Cells(i, 175).Value
Else
sh2.Range("q" & s).Value = ""
End If

If sh1.Cells(i, 16).Value = "ÖĞRETMEN" Or sh1.Cells(i, 16).Value = "UZMAN ÖĞRETMEN" Or sh1.Cells(i, 16).Value = "BAŞÖĞRETMEN" Then
sh2.Range("R" & s).Value = sh1.Cells(i, 175).Value
Else
sh2.Range("R" & s).Value = ""
End If

'HATA VEREN KOD BLOĞU
'-------------------------------------------------------------------------------------------------------------------------------


If sh1.Cells(i, 40).Value = "HESAPLANSIN" Then
aranan = sh1.Cells(i, 7).Value

'sh2.Cells(s, 19).Select


For k = 1 To sh3.Cells(Rows.Count, 8).End(xlUp).Row
bulunan = sh3.Cells(k, 8).Value
If aranan = bulunan Then
sh2.Cells(s, 19).Value = Fix(sh2.Cells(s, 7).Value / 7)
Exit For

Else
sh2.Cells(s, 19).Value = Fix(sh2.Cells(s, 7).Value / 10) ' BU SATIR HATA VERİYOR

End If
Next k

For k = 1 To sh3.Cells(Rows.Count, 9).End(xlUp).Row
bulunan2 = sh3.Cells(k, 9).Value    '
If aranan = bulunan2 Then
sh2.Cells(s, 19).Value = ""
Exit For
End If
Next k
End If

'-----------------------------------------------------------------------------------------------------------------------------

sh2.Range("t" & s).Value = sh1.Cells(i, 176).Value  'yönetim görevi
If sh1.Cells(i, 168).Value = "EVET" Then
sh2.Range("z" & s).Value = 2
Else
sh2.Range("z" & s).Value = ""
End If

sh2.Range("aa" & s).Value = sh2.Range("N" & s).Value + sh2.Range("O" & s).Value + sh2.Range("P" & s).Value + sh2.Range("Q" & s).Value + sh2.Range("R" & s).Value + sh2.Range("S" & s).Value + sh2.Range("T" & s).Value + sh2.Range("U" & s).Value + sh2.Range("V" & s).Value + sh2.Range("W" & s).Value + sh2.Range("X" & s).Value + sh2.Range("Y" & s).Value + sh2.Range("Z" & s).Value

s = s + 1
End If

Next i

'Sıra vnumarası veriliyor


For i1 = 10 To Range("b65000").End(3).Row
On Error Resume Next
If (Range("b" & i1).Value <> "") Then
Range("a" & i1) = i1 - 9
Range("a" & i1).Font.Size = 9
Range("a" & i1).HorizontalAlignment = xlCenter
End If
Next i1

'Kenarlk izimi
Dim m As Integer
    Dim Son As Long
    Son = sh2.Cells(Rows.Count, "B").End(3).Row
    For m = 1 To 4
        sh2.Range("A10:ah" & Son).Borders(m).LineStyle = 1  'Normal çizgiler çiziliyor
        sh2.Range("A10:ah" & Son).Font.Size = 9
        Next m
       

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With
   

MsgBox ("Ücret onayı hazırlandı...")
CommandButton7.Enabled = True
CommandButton8.Enabled = True
CommandButton9.Enabled = True
End If
End Sub

Çok sağol Halit bey. Elinize sağlık.

Kalansız Bölme

ahmed_ummu

Ekli dosyalar

ahmed_ummu

halit3

Uzman

ahmed_ummu

halit3

Uzman

ahmed_ummu

ahmed_ummu

Ekli dosyalar

halit3

Uzman

halit3

Uzman

ahmed_ummu

Ekli dosyalar

halit3

Uzman

ahmed_ummu