• DİKKAT

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

kömür takip işlemi

Katılım
21 Ocak 2013
Mesajlar
425
Excel Vers. ve Dili
2010
sorum ektedir umarım yardımcı olursunuz tek başına aşabileceğim bir sorun değil şimdiden kafa yoran herkese çok çok teşekkür ederim.
 

Ekli dosyalar

Ekli dosyayı inceleyiniz.
Sizin tariflerinizden biraz farklı olarak çözümlenmiştir.
Uygun bulunursa kullanabilirsiniz.
Formüller 5000 satır olarak düzenlenmiştir,isteğinize göre düzenleyebilirsiniz.
 

Ekli dosyalar

Merhaba,

Alternatif olarak VBA ile çözümü inceleyiniz.

Aşağıdaki kodlar "VERİ GİRİŞİ" sayfasının kod bölümünde olmalıdır.

Kod:
Private Sub CommandButton1_Click()
 
    Dim i       As Long, _
        j       As Long, _
        Rng     As String, _
        ShA     As Worksheet
 
    Application.ScreenUpdating = False
 
    Set ShA = Sheets("ALACAKLI KİŞİLER")
 
    i = Cells(Rows.Count, "B").End(3).Row
 
    If i < 3 Then
        MsgBox "KAYIT YOK Kİ NEYİ AKTARAYIM", vbCritical, "N. YEŞERTENER"
        Exit Sub
    End If
 
    j = ShA.Cells(Rows.Count, "B").End(3).Row + 1
 
    With Range("B3:F" & i)
        .Copy ShA.Cells(j, "B")
        .ClearContents
    End With
    i = ShA.Cells(Rows.Count, "B").End(3).Row
    Rng = Range("G" & j & ":G" & i).Address
    OnayKutusuEkle Rng
 
    Application.ScreenUpdating = True
 
End Sub

Aşağıdaki kodlarda "ALACAKLI KİŞİLER" sayfasının kod bölümünde olmalı.


Kod:
Private Sub CommandButton1_Click()
    Dim i   As Long, _
        j   As Long, _
        ShT As Worksheet
 
    Set ShT = Sheets("TAMAMLANMIŞ KİŞİLER")
    j = ShT.Cells(Rows.Count, "B").End(3).Row
 
    For i = 3 To Cells(Rows.Count, "B").End(3).Row
 
        If Cells(i, "G") = True And Cells(i, "H") = "" Then
 
            Cells(i, "H") = "ü"
            j = j + 1
            ShT.Cells(j, "B") = Cells(i, "B")
            ShT.Cells(j, "C") = Cells(i, "C")
            ShT.Cells(j, "D") = Cells(i, "D")
            ShT.Cells(j, "E") = Cells(i, "E")
            ShT.Cells(j, "F") = Cells(i, "F")
            ShT.Cells(j, "G") = "TAMAMLANDI"
 
        End If
 
    Next i
 
End Sub


Aşağıdaki kodlar ise bir modülde olmalıdır.


Kod:
Sub OnayKutusuEkle(Alan As String)
 
'http://www.mrexcel.com/forum/excel-questions/180887-add-checkboxes-through-visual-basic-applications-code.html
    Dim Rng         As Range
    Dim MyLeft      As Double
    Dim MyTop       As Double
    Dim MyHeight    As Double
    Dim MyWidth     As Double
 
    Application.ScreenUpdating = False
    Sheets("ALACAKLI KİŞİLER").Select
 
    For Each Rng In Range(Alan)
 
        MyLeft = Rng.Left
        MyTop = Rng.Top
        MyHeight = Rng.Height
        MyWidth = MyHeight = Rng.Width
 
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
 
        With Selection
            .Caption = ""
            .Value = xlOff
            .LinkedCell = Rng.Address
            .Display3DShading = False
        End With
 
    Next Rng
 
    Range("H1").Activate
    Sheets("VERİ GİRİŞİ").Select
    Application.ScreenUpdating = True
 
End Sub


Veri girişi yapıldıktan sonra aktar denildiğinde "VERİ GİRİŞİ" sayfasındaki veriler "ALACAKLI KİŞİLER" sayfasına aktarılır ve aktarılan satırlara Onay Kutusu otomatik olarak eklenir.

"ALACAKLI KİŞİLER" sayfasındaki butona basıldığında daha önce "TAMAMLANMIŞ KİŞİLER" sayfasına aktarılıp aktarılmadığını kontrol için H sütununa Çek işareti eklenmiştir.
 

Ekli dosyalar

  • ABC.rar
    ABC.rar
    27.8 KB · Görüntüleme: 70
teşekkur ederim yanlız alacak kişiler içinde doğru seçeneğini işaretleyip işlemi yap deyince o çalışma sayfasından silip tamamlanan kişiler içinde atmasını istiyorum yani işaret koyup işlem yap deyince kişi o çalışma sayfasından silmsini istiyorum bide o şeçeğeni doğru değilde tamamlandı olarak değiştirebilirmiyim.
 
bide alacaklı kişiler çalışma sayfasını nasıl alfabetik sıralama yapabilirim.
 
Merhaba,

Kodları değiştirdim.

Modülde olması gereken kod :

Kod:
Sub Sirala()
    
    Dim i   As Long
    
    Application.ScreenUpdating = False
    Sheets("ALACAKLI KİŞİLER").Select
    
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 3 Then Exit Sub
    Range("B3:G" & i).Sort Key1:=Range("B1")
    
    Sheets("VERİ GİRİŞİ").Select
    Application.ScreenUpdating = True
 
End Sub

"VERİ GİRİŞ" Sayfasının kod bölümü :

Kod:
Private Sub CommandButton1_Click()
    
    Dim i       As Long, _
        j       As Long, _
        Rng     As String, _
        ShA     As Worksheet
    
    Application.ScreenUpdating = False
    
    Set ShA = Sheets("ALACAKLI KİŞİLER")
    
    i = Cells(Rows.Count, "B").End(3).Row
    
    If i < 3 Then
        MsgBox "KAYIT YOK Kİ NEYİ AKTARAYIM.........", vbCritical, "N. YEŞERTENER"
        Exit Sub
    End If
    
    j = ShA.Cells(Rows.Count, "B").End(3).Row + 1
    
    With Range("B3:F" & i)
        .Copy ShA.Cells(j, "B")
        .ClearContents
    End With
    i = ShA.Cells(Rows.Count, "B").End(3).Row
    Rng = Range("G" & j & ":G" & i).Address
    
    Sirala
        
    Application.ScreenUpdating = True
    
End Sub


"ALACAKLI KİŞİLER" Sayfasında 2 ayrı Sub var.

Kod:
Private Sub CommandButton1_Click()
 
    Dim i   As Long, _
        j   As Long, _
        ShT As Worksheet
    
    Set ShT = Sheets("TAMAMLANMIŞ KİŞİLER")
    j = ShT.Cells(Rows.Count, "B").End(3).Row
    
    For i = 3 To Cells(Rows.Count, "B").End(3).Row
    
        If Cells(i, "G") = "TAMAMLANDI" Then
        
            j = j + 1
            ShT.Cells(j, "B") = Cells(i, "B")
            ShT.Cells(j, "C") = Cells(i, "C")
            ShT.Cells(j, "D") = Cells(i, "D")
            ShT.Cells(j, "E") = Cells(i, "E")
            ShT.Cells(j, "F") = Cells(i, "F")
            ShT.Cells(j, "G") = "TAMAMLANDI"
            Cells(i, "B") = ""
        End If
        
    Next i
    
    Range("B3:B" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
End Sub

Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [G:G]) Is Nothing Or Target.Row < 3 Then Exit Sub
    If Target.Value = "" Then
        Target.Value = "TAMAMLANDI"
    Else
        Target.Value = ""
    End If
End Sub

"ALACAKLI KİŞİLER" Sayfasında G sütununda ilgili kişinin satırında Çift Tıklandığında "TAMAMLANDI" yazar.
 

Ekli dosyalar

  • ABC.rar
    ABC.rar
    28.4 KB · Görüntüleme: 39
hocam birşey soracam ilk gönderdiğiniz çalışmadaki gibi onay kutusu olması için ne yapmam lazım bide alfabetik olarak nasıl sıralamayapabilir alacaklı kişilerde.
 
hocam birşey soracam ilk gönderdiğiniz çalışmadaki gibi onay kutusu olması için ne yapmam lazım bide alfabetik olarak nasıl sıralamayapabilir alacaklı kişilerde.


Merhaba,

Alfabetik sıralama yapıyor ama ikinci sayfada yapıyor. siz diğer saydafa yani tamamlananların sayfasında da mı sıralı istiyorsunuz.

Onay kutusu olunca silme işleminde, sıkıntı yaşatır. hem satırı sil hem o satırda hangi adlı onay kutusu vardı vs vs.
 
tamam hocam elinize sağlık kısmı olarak tüm sorunları açtım yalnız bir sorum var sayfa koruması yapmak istiyorum 2 ve 3 sayfada ama hata veriyo bunu nasıl aşarım
 
tamam hocam elinize sağlık kısmı olarak tüm sorunları açtım yalnız bir sorum var sayfa koruması yapmak istiyorum 2 ve 3 sayfada ama hata veriyo bunu nasıl aşarım

Dosyayı görmeden, kodları görmeden nasıl yanıt verilir ki? :)
 
hocam dosyada bir değişiklik yapmadım sadece sizin eklediğiniz dosya üzerinden alacaklı kişiler ile tamamlanmış kişiler olan sayfaları koruma yapmak istiyorum ama sonuç alamadım.
 
hocam dosyada bir değişiklik yapmadım sadece sizin eklediğiniz dosya üzerinden alacaklı kişiler ile tamamlanmış kişiler olan sayfaları koruma yapmak istiyorum ama sonuç alamadım.

anladım fakat koruma olacaksa sayfa şifrelerinin makroda belirtilmesi gerekir, önce sayfa koruması kaldırılır kodlar çalışır sonra tekrar sayfaya korumaya alınır.

Bu kodları makronun başına koymak gerekir. Yarın zamanım olursa bakarım.
 
Merhaba,

Sayfa şifresi için bir değişken kullandım. Bunu Modul1'in başından anlayabilirsiniz.

Kod:
Public Const Sifre As String = "ABC"

Şifre olarak "ABC" seçtim siz bunu değiştiriniz.

"ALACAKLI KİŞİLER" sayfasının G sütununun Biçiminde Koruma seçeneğini kaldırdım. Sayfa korunmuş olsa bile sonradan bu sütun üzerinde işlem yapılacaktır.

Kodları tekrarlamayacağım doğrudan dosyayı ekliyorum. Kodları inceleyiniz.
 

Ekli dosyalar

  • ABC.rar
    ABC.rar
    30.8 KB · Görüntüleme: 37
sayın hocam diğer iki çalışma sayfasında sorun yok ama veri girişi yaptıktan sonra alacaklı kişiler sayfasına atınca koruma sağlamıyor
 
Geri
Üst