Çözüldü Sayfalarda belirlenen alanlardaki dolu hücreleri silme?

[s.savas]

Merhaba arkadaşlar.
Aşağıda kod ile belirlenmiş sabit aralıktaki verileri siliyorum.

s1.Range("a8:aı32").ClearContents
s2.Range("b5:u29").ClearContents

Bu kodu; s1 sayfasındaki A8:AI aralığındaki son dolu hücreye kadar olan verileri silmesi için şu şekilde revize ediyorum.

s1.Activate
x = WorksheetFunction.CountA(Range("C7:C65536")) + 6
s1.Range("A8:AI" & x).ClearContents

s2.Select
Y = WorksheetFunction.CountA(Range("b5:b65536")) + 4
s2.Range("B5:T" & Y).ClearContents

Sorunum şu s1 veya s2 sayfalarında belirlenmiş alanlarda veri varsa sıkıntı yok, çalışıyor. Veri yoksa kod hata veriyor.

 

[Ömer BARAN]

Merhaba.
Bir sayfadaki belli alanda yer alan verileri silmek için o sayfanın seçilmesine (aktif hale getirilmesine) lüzum yok.
Aşağıdaki gibi deneyin.
Kod'un silme satırından önce Set s1=Sheets(......) şelinde tanımlama yapıldığı varsayıldı.

x = s1.Cells(Rows.Count, "C").End(3).Row
If x > 7 Then s1.Range("A8:AI" & x).ClearContents

 

[s.savas]

Ömer hocam çok teşekkür ediyorum.
Her zamanki gibi çok hızlı cevap ve çözüm üretiyorsunuz.
İzin verirseniz yeni bir konu açmadan aynı konunun devamı olarak farklı iki soru sormak isterim.
1-Bordro isimli şablonda F:T sütunlarında sütun toplamlarını son dolu satırın altında toplamak,
2-Toplamların alındığı satırın bir satır altında örnek resimde de görüldüğü üzere açıklama metni yazdırmak mümkünmü?

 

[Ömer BARAN]

A, B ve C sütunlarındaki verilerin (özellikle A sütunundaki sayılar) hangi makro kullanılarak yazıldığını belirtir misiniz?
Bu sütunlara veri yazan kodlara ilave yapılarak istenilen sonuca ulaşılabilir gibi görünüyor.
.

 

[s.savas]

A, B ve C sütunlarındaki verilerin (özellikle A sütunundaki sayılar) hangi makro kullanılarak yazıldığını belirtir misiniz?
Bu sütunlara veri yazan kodlara ilave yapılarak istenilen sonuca ulaşılabilir gibi görünüyor.
.

Userform6 da Combobox2 de

For i = 1 To s1.Cells(Rows.Count, "C").End(3).Row - 7
s1.Range("A" & i + 7) = i
Next

For k = 1 To s2.Cells(Rows.Count, "C").End(3).Row - 4
s2.Range("B" & k + 4) = k
s2.Range("U" & k + 4) = k
Next

 

[Ömer BARAN]

Tekrar merhaba.
Devamsızlık ve Bordro sayfalarında işlem yapmak üzere Module15 'de yer alan ve herbir sütun için ayrı ayrı oluşturulmuş,
ilgili alana formül uygulayan makroların tümünü silip, bunların yerine aşağıdaki kodları yapıştırın.
Aşağıdaki kod alana, yine ilgili formülleri uygular ve ardından da bu formüllerin yerine DEĞER olarak, formül sonuçlarını yazar.
Dikkat: Bu nedenle; diğer kodlarınızda (hangileri olduğunu bilemiyorum), Makro3, Makro4, ...... gibi kodları silip,
sadece Makro1 ve Makro2'yi bırakın.

NOT:
-- Bordro sayfasında E sütunundaki (ASGARİ ÜCRET BRÜT) dğerler SAYI DEĞİL, bu sütuna değerleri yazan,
-- Benzer şekilde yine Bordro sayfası M sütunundaki AGİ tutarlarını yazan,
makroların hangileri olduğunu anlayamadığım için Bordro sayfası E ve M sütunu için herhangi bir işlem yok.

Sub Makro1()
Dim i As Long
Set d = Sheets("Devamsızlık_Formu")
i = WorksheetFunction.CountA(d.Range("C7:C65536")) + 6
d.Range("AI8:AI" & i).NumberFormat = "00"
d.[AI8].Formula = "=IF(COUNT($D$7:$AH$7)=31,30-COUNTA(D8:AH8),IF(COUNT($D$7:$AH$7)=30,30-COUNTA(D8:AH8),IF(COUNT($D$7:$AH$7)=28,28-COUNTA(D8:AH8))))"
d.[AI8].AutoFill Destination:=d.Range("AI8:AI" & i)

d.Range("AI8:AI" & i).Value = d.Range("AI8:AI" & i).Value

End Sub

Sub Makro2()
Dim i As Long
Set b = Sheets("Bordro")
i = WorksheetFunction.CountA(b.Range("C5:C65536")) + 4
b.[F5].Formula = "=IF(D5="""","""",VLOOKUP(D5,Devamsızlık_Formu!$B$8:$AI$32,34,0))"
b.[G5].Formula = "=IF(D5="""","""",E5/30*F5)"
b.[H5].Formula = "=IF(D5="""","""",G5*0.14)"
b.[I5].Formula = "=IF(D5="""","""",G5*0.01)"
b.[J5].Formula = "=IF(D5="""","""",G5-H5-I5)"
b.[K5].Formula = "=IF(D5="""","""",J5*0.15)"
b.[L5].Formula = "=IF(D5="""","""",ROUND(K5-M5,2))"
b.[N5].Formula = "=IF(D5="""","""",G5*$N$4)"
b.[O5].Formula = "=IF(D5="""","""",H5+I5+L5+N5)"
b.[P5].Formula = "=IF(D5="""","""",ROUND(Q5-O5,2))"
b.[Q5].Formula = "=IF(D5="""","""",G5)"
b.[R5].Formula = "=IF(D5="""","""",G5*0.205)"
b.[s5].Formula = "=IF(D5="""","""",G5*0.02)"
b.[T5].Formula = "=IF(D5="""","""",ROUND(Q5+R5+S5,3))"

b.[F5:T5].AutoFill Destination:=b.Range("F5:T" & i)
b.Range("F5:T" & İ).Value = b.Range("F5:T" & i).Value

Sheets("Devamsızlık_Formu").Activate
End Sub

 

[s.savas]

Hocam elinize sağlık.
Sayı olmayan veriler hususunda haklısınız.
İlk veriler userform1 ile veritabanındaki veriler isimli tabloya ekleniyor.
İlgili alanlardaki veri türleri şu şekilde: Buradaki veri türlerini sayı veya yüzdelik yapınca başka sorunlar yaşıyorum. Metin yapınca değerler sayıya dönüşmüyor. Daha çook bilmediğimiz husus varmış !!
Benzer şekilde diğer tablolarda da veri türü tanımlarında yanlış tanımlamalar vardır mutlaka..

 

[s.savas]

Bu arada şunu da belirtmeliyim üstadım. Yukarıda tanımladığınız
b.[F5].Formula = "=IF(D5="""","""",VLOOKUP(D5,Devamsızlık_Formu!$B$8:$AI$32,34,0))"
kodunu döngüye almak gerekiyor. Çünkü; Devamsızlık_Formu şablonundaki veriler sabit değil. 32 satırdan eksik te olabiliyor fazla da.

 

[Ömer BARAN]

Tekrar merhaba.
6 numaralı cevapta verdiğim Makro2 isimli kod'u aşağıdakiyle değiştirirseniz,
-- 3 numaralı cevapta belirttiğiniz, listenin sonuna eklenecek TOPLAM satırı,
-- uzun cümle,
-- İMZA satırları,
-- son cevabınızda belirttiğiniz Devamsızlık sayfası son satır numarasının formüle dahil edilmesi,
-- Bordro sayfası E sütunundaki METİN olan sayıların (Brüt Asgari Ücret) SAYIya dönüştürülmesi
meseleleri de halledilmiş olur.
-- Ayrıca; Kodda yer alan metin1, metin2 ve metin3 değişkenlerinin karşısındaki çift tırnak arasına asıl cümlenizin ilgili parçalarını eklersiniz.

Sub Makro2()
Dim i As Long
Set b = Sheets("Bordro")
Set d = Sheets("Devamsızlık_Formu")
i = WorksheetFunction.Max(b.[B:B]) + 4
dson = WorksheetFunction.Max(d.[A:A]) + 7
For sat = 5 To i
    b.Cells(sat, "E") = 1 * b.Cells(sat, "E")
Next
b.[F5].Formula = "=IF(D5="""","""",VLOOKUP(D5,Devamsızlık_Formu!$B$8:$AI$" & dson & ",34,0))"
b.[G5].Formula = "=IF(D5="""","""",E5/30*F5)"
b.[H5].Formula = "=IF(D5="""","""",G5*0.14)"
b.[I5].Formula = "=IF(D5="""","""",G5*0.01)"
b.[J5].Formula = "=IF(D5="""","""",G5-H5-I5)"
b.[K5].Formula = "=IF(D5="""","""",J5*0.15)"
b.[L5].Formula = "=IF(D5="""","""",ROUND(K5-M5,2))"
b.[N5].Formula = "=IF(D5="""","""",G5*$N$4)"
b.[O5].Formula = "=IF(D5="""","""",H5+I5+L5+N5)"
b.[P5].Formula = "=IF(D5="""","""",ROUND(Q5-O5,2))"
b.[Q5].Formula = "=IF(D5="""","""",G5)"
b.[R5].Formula = "=IF(D5="""","""",G5*0.205)"
b.[s5].Formula = "=IF(D5="""","""",G5*0.02)"
b.[T5].Formula = "=IF(D5="""","""",ROUND(Q5+R5+S5,3))"

b.[F5:T5].AutoFill Destination:=b.Range("F5:T" & i)
b.Range("F5:T" & i).Value = b.Range("F5:T" & i).Value

b.Range("F" & i + 1).Formula = "=SUM(F5:F" & i & ")"
b.Range("F" & i + 1).AutoFill Destination:=b.Range("F" & i + 1 & ":T" & i + 1)
b.Range("F" & i + 1 & ":T" & i + 1).Value = b.Range("F" & i + 1 & ":T" & i + 1).Value
b.Range("G" & i + 1 & ":T" & i + 1).NumberFormat = "#,##0.00"
metin1 = "ANKARA ÇALIŞMA.....ÇALIŞAN "
metin2 = b.Cells(i, "B") & " İŞÇİYE AİT.... " & b.[R2].Text & " " & b.[T2].Text
metin3 = " DÖNEM ÜCRETİNİN, " & Format(b.Cells(i + 1, "T"), "#,##0.00") & " TL OLDUĞUNU TEYİT EDERİZ."
b.Cells(i + 2, "B").HorizontalAlignment = xlLeft
b.Cells(i + 2, "B") = metin1 & metin2 & metin3
b.Cells(i + 4, "E") = "Koordinatör": b.Cells(i + 4, "O") = "İmza Yetkilisi"
b.Cells(i + 6, "E") = "UNVAN1": b.Cells(i + 6, "O") = "UNVAN2"
b.Cells(i + 7, "E") = "Adı SOYADI": b.Cells(i + 7, "O") = "Adı SOYADI"
b.Rows(i + 2 & ":" & i + 7).AutoFit
Application.CutCopyMode = False
Sheets("Devamsızlık_Formu").Activate
End Sub

 

[Ömer BARAN]

Bir önceki cevabımı güncelledim.
Sayfayı yenileyerek bir önceki cevabıma tekrar bakınız.

 

[s.savas]

Ömer hocam çok teşekkür ederim.
Bordro şablonundaki O2 hücresinde bulunan =EĞERSAY(F5:F29;">=1") formülünü de F5 ten veya Devamsızlık_Formu C8 ten son dolu satıra kadarki toplam kişi sayısını bulan kod şekline çevirirseniz çalışmam son şeklini almış olacak.
Çalışmanın son hali.

 

[Ömer BARAN]

Bence formül yerine, Makro2'de, önerim üzerine eklediğiniz aşağıdaki kırmızı satırların heman altına,
mavi olanlardan birini eklerseniz istediğiniz olur.

For sat = 5 To i
    b.Cells(sat, "E") = 1 * b.Cells(sat, "E")
Next
b.[O2] = i - 4
b.[O2] = dson - 7

 

[s.savas]

Teşekkür ederim üstadım.
Bordro şablonunda katılımcı sayısının değişken olması nedeniyle biçimlendirmenin de katılımcı sayısıyla birlikte değişmesi için makro kaydet ile biçimlendirme yapıyorum.
Burada şunu farkettim.

k = s2.Cells(Rows.Count, "B").End(3).Row
If k > 4 Then s2.Range("B5:U" & k).ClearContents

Kodu ile Bordro şablonundaki B5:U aralığındaki tüm hücrelerin temizlenmediği görülmektedir.
Diğer husus userform6 da combobox2 ile TYP Programları değiştirilince aşağıdaki formüller hata mesajı veriyor.
Örnek çalışmada aslında her iki programın verileri de veriler isimli tablodan gelmekte ve aynı tablolardaki veritipleri de aynı. TYP0002 de doğru çalışan kod TYP0001 olunca neden hata verir anlamadım.

b.[L5].Formula = "=IF(D5="""","""",ROUND(K5-M5,2))"
b.[O5].Formula = "=IF(D5="""","""",H5+I5+L5+N5)"
b.[P5].Formula = "=IF(D5="""","""",ROUND(Q5-O5,2))"

k = s2.Cells(Rows.Count, "B").End(3).Row
If k > 4 Then s2.Range("B5:U" & k).ClearContents
If k > 4 Then s2.Range("B5:U" & k).Borders(xlDiagonalDown).LineStyle = xlNone
If k > 4 Then s2.Range("B5:U" & k).Borders(xlDiagonalUp).LineStyle = xlNone
If k > 4 Then s2.Range("B5:U" & k).Borders(xlEdgeLeft).LineStyle = xlNone
If k > 4 Then s2.Range("B5:U" & k).Borders(xlEdgeTop).LineStyle = xlNone
If k > 4 Then s2.Range("B5:U" & k).Borders(xlEdgeBottom).LineStyle = xlNone
If k > 4 Then s2.Range("B5:U" & k).Borders(xlEdgeRight).LineStyle = xlNone
If k > 4 Then s2.Range("B5:U" & k).Borders(xlInsideVertical).LineStyle = xlNone
If k > 4 Then s2.Range("B5:U" & k).Borders(xlInsideHorizontal).LineStyle = xlNone

 

[Ömer BARAN]

Son belgeye bakmadım.
Veri alanını temizleme işlemini aşağıdaki şekilde yapın.
Böylece kenarlık SAYI/METİN/TARİH gibi biçim ayarları vs. hücre birleştirmeleri dahil TAM TEMİZLİK yapmış olursunuz.

Sorduğunuz diğer hususu anladığımı söyleyemem.

k = s2.Cells(Rows.Count, "B").End(3).Row
If k > 4 Then s2.Range("B5:U" & Rows.Count).UnMerge
If k > 4 Then s2.Range("B5:U" & Rows.Count).Clear

 

[Ömer BARAN]

Tekrar merhaba.
Umarım yanlış düşünmüyorum.
-- Veri tabanı dosyanızda (mdb dosya'nın katılımcı listesi bölümünde, ikinci sütunda) TYP001 verisi yok.
-- Makro1'deki kod'a aşağıdaki yeşil kısmı, kırmızı satırların arasına ekleyin/değiştirin.

i = WorksheetFunction.Max(d.[A:A]) + 7
If i = 7 Then Exit Sub
d.Range("AI8:AI" & i).NumberFormat = "00"

-- Makro2'deki kod'a aşağıdaki yeşil kısmı, kırmızı satırların arasına ekleyin.

i = WorksheetFunction.Max(b.[B:B]) + 4
dson = WorksheetFunction.Max(d.[A:A]) + 7
If i = 4 Or dson = 7 Then Exit Sub
For sat = 5 To i
    b.Cells(sat, "E") = 1 * b.Cells(sat, "E")
    b.Cells(sat, "M") = 1 * b.Cells(sat, "M")
Next

-- UserForm6'daki Combobox1_Change kodu'nun End Sub satırından önce aşağıdaki satırı ekleyin.

If Me.ComboBox2 <> "" Then ComboBox2_Click

 

[s.savas]

Tekrar merhaba.
Umarım yanlış düşünmüyorum.
-- Veri tabanı dosyanızda (mdb dosya'nın katılımcı listesi bölümünde, ikinci sütunda) TYP001 verisi yok.
-- Makro1'deki kod'a aşağıdaki yeşil kısmı, kırmızı satırların arasına ekleyin/değiştirin.

i = WorksheetFunction.Max(d.[A:A]) + 7
If i = 7 Then Exit Sub
d.Range("AI8:AI" & i).NumberFormat = "00"

-- Makro2'deki kod'a aşağıdaki yeşil kısmı, kırmızı satırların arasına ekleyin.

i = WorksheetFunction.Max(b.[B:B]) + 4
dson = WorksheetFunction.Max(d.[A:A]) + 7
If i = 4 Or dson = 7 Then Exit Sub
For sat = 5 To i
    b.Cells(sat, "E") = 1 * b.Cells(sat, "E")
    b.Cells(sat, "M") = 1 * b.Cells(sat, "M")
Next

-- UserForm6'daki Combobox1_Change kodu'nun End Sub satırından önce aşağıdaki satırı ekleyin.

If Me.ComboBox2 <> "" Then ComboBox2_Click

Hocam teşekkür ediyorum.
Sayenizde, zuhur etmiş bütün sorunlar giderildi.
Gördüğüm kadarıyla hesaplamada bir etkisi olmamakla birlikte görsellik açısından bazı hücrelerde kuruş basamağındaki 0 (sıfır) gösterilmiyor.

 

[Ömer BARAN]

Makro2'nin son kısmında kırmızı satırların arasına aşağıdaki yeşil olan satırı ekleyin.
Hatta; sanıyorum, gereksiz durumda kalan Application.CutCopyMode = False satırı silinebilir.

b.Rows(i + 2 & ":" & i + 7).AutoFit
b.Range("E7:E" & i + 1 & ", G7:T" & i + 1).NumberFormat = "#,##0.00"
Application.CutCopyMode = False

 

[s.savas]

Görsellik açısından da gayet güzel oldu.
Elinize emeğinize sağlık.

Şimidi de Bordro şablonunu PDF olarak kaydetmek için netten bulduğum kodu revize ettim.
Ekli PDF sayfasında da görüleceği üzere şablonun en alt kısmında bulunan koordinatör, imza yetkilisi gibi kısımları PDF ye ekleyemedim.

Sub Bordo_PDF_Olarak_Kaydet()
Dim i As Long
Set b = Sheets("Bordro")
Set d = Sheets("Devamsızlık_Formu")
i = WorksheetFunction.Max(b.[B:B]) + 4

dosya_adı = ActiveWorkbook.Name
b.Range("A1:T" & i).Select

Dönem = Sheets("Bordro").Range("J2").Value
strdate = Format(Now, "dd-mm-yyyy ")

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & "-" & Dönem & "-" & strdate, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Range("C1").Select
    Selection.ClearContents
End Sub

 

[Ömer BARAN]

Kod'un son kısmını aşağıdaki şekilde değiştirerek deneyiniz.
Kodlarınızda mümkün olduğunca SELECT ibaresini kullanmamaya çalışınız.

dosya_adi = ActiveWorkbook.Name
Dönem = b.[J2].Value
strdate = Format(Now, "dd-mm-yyyy ")

b.Range("A1:T" & i+7).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & "-" & Dönem & "-" & strdate, Quality:=xlQualityStandard, _
IncludeDocProperties:=True
b.[C1].ClearContents
End Sub

 

[s.savas]

Tekrar çok teşekkür ediyorum.