• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile verileri düzgün hale getirme..

F

feridici_genc

Katılım
28 Şubat 2011
Mesajlar
605
Excel Vers. ve Dili
2010 - Türkçe - Win10 x64
Hayırlı günler,
Ekte bulunan belge de "1" isimli sayfa bir program çıktısına ait. bu sayfadaki verileri ve sayfa düzenini "Örnek tablo" isimli sayfadaki ki gibi yapmaya çalışıyorum. ben örnek olarak 4 kişi için yaptım. tüm kişiler için yapılması gerekmekte. Formül ile olması imkansız gibi görülüyor.
Yardımlarınızı rica ediyorum.
Bilgi notu; Tüm çalışanların aylık çalışmaları eşit değil. mesela çoğu işçi için 30 satır yeterli iken bazı işçiler 32 33 satıra çıkıyor bu dikkat edilmeli.
Teşekkürler..

http://s3.dosya.tc/server6/4sca1p/1.xlsx.html
 

Ekli dosyalar

  • 1.xlsx
    1.xlsx
    164 KB · Görüntüleme: 2
Son düzenleme:
Problem benden mi kaynaklanıyor bilmiyorum ama dosyanız boş gözüküyor.
Aynı zamanda hata veriyor: Sheet001.htm dosyası eksik.
 
Bendede aynı hatayı verdi, eksik dosya hatası veriyor.
 
excel görünümlü htm dosyası olarak kaydediyor program. ben onu xlsx formatında kaydedip yüklediğimi sanmıştım ama yanlış olmuş yarın düzeltip tekrar ekleyeceğim konuya özür dilerim herkesten.
 
Merhaba,
Aşağıdaki kodu deneyiniz.
Tablo olayını da el ile ya da koşullu biçimlendirme ile ayarlayabilirsiniz.
Kod: 
Sub KOD()
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Integer, x As Integer
Set s1 = Sheets("1")
Set s2 = Sheets("Örnek tablo")
x = 3

Application.ScreenUpdating = False

With s2.Cells
    .ClearContents
    .UnMerge
    .Font.Name = "Verdana"
    .Font.Size = 8
    .Font.Bold = False
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .RowHeight = 15
End With

s2.Range("F:G").NumberFormat = "hh:mm;@"
s2.Range("E:E").HorizontalAlignment = xlLeft
s2.Range("D:D").Font.Size = 7

For a = 3 To s1.Range("A65500").End(3).Row
    If s1.Cells(a, "A") = "Kart No:" Then
        kn = s1.Cells(a, "B")
        sn = s1.Cells(a + 1, "B")
        ad = s1.Cells(a + 2, "B") & " " & s1.Cells(a + 3, "B")
        s2.Cells(x, "B") = "Kart No:"
        s2.Cells(x, "C") = "Sicil No:"
        s2.Cells(x, "D") = "ADI - SOYADI"
        s2.Cells(x, "E") = "Tarih"
        s2.Cells(x, "F") = "Giriş"
        s2.Cells(x, "G") = "Çıkış"
        
        With s2.Range("B" & x & ":G" & x)
            .Font.Bold = True
            .Font.Size = 8
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        
        x = x + 1
        
    ElseIf IsDate(Left(s1.Cells(a, "A"), 10)) Then
        s2.Cells(x, "B") = kn
        s2.Cells(x, "C") = sn
        s2.Cells(x, "D") = ad
        s2.Cells(x, "E") = s1.Cells(a, "A")
        s2.Cells(x, "F") = s1.Cells(a, "B")
        s2.Cells(x, "G") = s1.Cells(a, "C")
        x = x + 1
        
    ElseIf s1.Cells(a, "A") = "" Then
        s2.Cells(x, "B") = kn
        s2.Cells(x, "C") = sn
        s2.Cells(x, "D") = ad
        s2.Range("E" & x - 1 & ":E" & x).MergeCells = True
        s2.Cells(x, "F") = s1.Cells(a, "B")
        s2.Cells(x, "G") = s1.Cells(a, "C")
        x = x + 1
        
    End If
    
Next

Application.ScreenUpdating = True
End Sub
 
Selam iyi akşamlar. 7 yıl sonra bu konu tekrar lazım oldu.
Fakat kod nedense çalışmamaya başladı.
sanırım şuanda kullandığım office-2016 olduğundan kaynaklanıyor.
Yardımcı olabilirmisiniz?
 
Peki sorun nedir?

Hata mı veriyor?

İstenen sonucu vermiyor mu?

Yardım için önce sorunu tespit etmek gerekir.

Ben de 2016 sürümünü kullanıyorum. Denediğimde problem çıkmadan kodlar çalıştı.
 
Merhaba. 5 Nolu cevapta paylaştığım örnek üzerinde denedim. Örnek tablo isimli sayfada ki gibi veriler düzgün bir şekilde gelmiyor. 1 kaç saniye çalışıyor makro işlem yarıda kesiliyor. örnek olarak resim yükledim.

 
yani kişilerin orada 30 günlük sıralanması gerekirken bazen 1 baezen 3 satır geliyor satır başına
Umarım anlatabilmişimdir
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst