• DİKKAT

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

Satır birleştirme

  • Konbuyu başlatan Konbuyu başlatan ormann
  • Başlangıç tarihi Başlangıç tarihi
Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
Satır Silme

Ekteki dosyamda veri girişi sayfasında “D2 “hücresinden kayıt sayfasından verileri çağırıyorum.Ve arşive gönder butonuna bastığımda kayıt sayfasından çağırdığım verileri arşiv sayfasına gönderiyorum.Ancak kayıt bölümünden çıkan verinin satırı boş kalıyor. Benim istediğim boş kalan satırların aynı makroyla silinmesi
 

Ekli dosyalar

Son düzenleme:
Yukarıdaki örnek dosyamda bulunan kayıt sayfasındaki boş satırları makroyla nasıl sildirebiliriz
 
Son düzenleme:
Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod:
Option Explicit
 
Sub Arsive_Gonder()
    Dim ara As Range
    If Sheets("VERİ GİRİŞİ").Range("D5").Value = "" Then
    
    MsgBox "ARŞİVE GÖNDERMEDEN ÖNCE LÜTFEN VERİYİ ÇAĞIRINIZ", vbInformation
    Range("a1").Select
    Exit Sub
    Else
    
    If MsgBox("VERİLERİNİZ ARŞİVE GÖNDERİLSİN Mİ ?", vbExclamation + vbYesNo, "") = vbYes Then
    
    Application.ScreenUpdating = False
    Sheets("ARŞİV").Select
    If Range("a2").Value = "" Then
    Sheets("VERİ GİRİŞİ").Select
    Range("D5:D14").Select
    
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("b2").Select
    Selection.PasteSpecial Paste:=xlValues, Transpose:=True
    Application.CutCopyMode = False
    Range("a2").Value = Format(Now, "dd.mm.yyyy")
    Range("a1").Select
    Else
    Sheets("VERİ GİRİŞİ").Select
    Range("D5:D14").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    [b65536].End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlValues, Transpose:=True
    Application.CutCopyMode = False
    [a65536].End(xlUp).Offset(1, 0).Select
    ActiveCell.Value = Format(Now, "dd.mm.yyyy")
    
    MsgBox "VERİLERİNİZ ARŞİVE GÖNDERİLDİ", vbInformation
    Sheets("VERİ GİRİŞİ").Range("D5:D14").Value = ""
    Range("A1").Select
    On Error Resume Next
    Set ara = Worksheets("KAYIT").Range("A2:A65536").Find(Worksheets("VERİ GİRİŞİ").Range("D2"))
    ara.EntireRow.Delete
    End If
    End If
    End If
    Sheets("VERİ GİRİŞİ").Select
End Sub
 
Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod:
Option Explicit
 
Sub Arsive_Gonder()
    Dim ara As Range
    If Sheets("VERİ GİRİŞİ").Range("D5").Value = "" Then
    
    MsgBox "ARŞİVE GÖNDERMEDEN ÖNCE LÜTFEN VERİYİ ÇAĞIRINIZ", vbInformation
    Range("a1").Select
    Exit Sub
    Else
    
    If MsgBox("VERİLERİNİZ ARŞİVE GÖNDERİLSİN Mİ ?", vbExclamation + vbYesNo, "") = vbYes Then
    
    Application.ScreenUpdating = False
    Sheets("ARŞİV").Select
    If Range("a2").Value = "" Then
    Sheets("VERİ GİRİŞİ").Select
    Range("D5:D14").Select
    
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("b2").Select
    Selection.PasteSpecial Paste:=xlValues, Transpose:=True
    Application.CutCopyMode = False
    Range("a2").Value = Format(Now, "dd.mm.yyyy")
    Range("a1").Select
    Else
    Sheets("VERİ GİRİŞİ").Select
    Range("D5:D14").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    [b65536].End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlValues, Transpose:=True
    Application.CutCopyMode = False
    [a65536].End(xlUp).Offset(1, 0).Select
    ActiveCell.Value = Format(Now, "dd.mm.yyyy")
    
    MsgBox "VERİLERİNİZ ARŞİVE GÖNDERİLDİ", vbInformation
    Sheets("VERİ GİRİŞİ").Range("D5:D14").Value = ""
    Range("A1").Select
    On Error Resume Next
    Set ara = Worksheets("KAYIT").Range("A2:A65536").Find(Worksheets("VERİ GİRİŞİ").Range("D2"))
    ara.EntireRow.Delete
    End If
    End If
    End If
    Sheets("VERİ GİRİŞİ").Select
End Sub

Teşekkürler Korhan Bey,benimde işime yaradı o kod.Entirerow ve entirecolumn komutları aklıma gelmemişti böyle birşeyde
 
Sayın Korhan bey ve Sayın Truvali Sizlere çok teşşekkür ederim.Emeğiniz ve hizmetlerininz izin.Korhan bey acaba arşiv sayfasına gönderilen aynı veriden iki tane varsa bir başka satıra değilde aynı satır üzerine kayıt yapabilirmiyiz ?

24.03.2011 130 Ali Özen Metin Ayşe
24.03.2011 138 VELİ
24.03.2011 138 veli
24.03.2011 130 Ali Özen Metin Ayşe
 
Son düzenleme:
Sayın Korhan bey ve Sayın Truvali Sizlere çok teşşekkür ederim.Emeğiniz ve hizmetlerininz izin.Korhan bey acaba arşiv sayfasına gönderilen aynı veriden iki tane varsa bir başka satıra değilde aynı satır üzerine kayıt yapabilirmiyiz ?

24.03.2011 130 Ali Özen Metin Ayşe
24.03.2011 138 VELİ
24.03.2011 138 veli
24.03.2011 130 Ali Özen Metin Ayşe

Tekrar Merhaba.Örneğe eklemeler yaptım.Eğer kayıt yapmak istediğiniz veri önceden kayıtlıysa size uyarı verecek ve kayıtı yapmayacak.Aynı zamanda Değiştir ve Sil düğmeleri de ekledim "VERİ GİRİŞİ" sayfasına.Bu düğmeler sayesinde önce çağırdığınız veri üzerinde değişiklik ve silme yapabilirsiniz.
 

Ekli dosyalar

Sayın Turuvali size çok teşekkür ederim.Anlayamadığım bir şey var C2,d2,e2,f2,g2 hücrelerinden çağırdığım zaman bunları kayıt sayfasından çıkarmıyı.fakat arşive gönderiyo.sadece D2 hücresinden çağırdığım verileri kayıt sayfasından çıkarıp arşive gönderiyo .o kadar uğraştım bir türlü analayamadım.
 
Birde Syn Turuvali arşive aktardığım zaman tekrar ana sayfaya dönüş yapmıyo.Ayrıca veri girişindeki veriler silinmiyo
 
Sayın Turuvali size çok teşekkür ederim.Anlayamadığım bir şey var C2,d2,e2,f2,g2 hücrelerinden çağırdığım zaman bunları kayıt sayfasından çıkarmıyı.fakat arşive gönderiyo.sadece D2 hücresinden çağırdığım verileri kayıt sayfasından çıkarıp arşive gönderiyo .o kadar uğraştım bir türlü analayamadım.

Çünkü yazılan kodlarda D2 hücresine göre işlem yapılıyor.Aşağıdaki kodda renkli olan kısmı hangi hücreden çağırıyorsanız değiştirince düzelir.Örnek olarak D2'den değil de c2'den çağırmak istiyorsanız aşağıdaki kodda D2 yerine c2 yazmanız lazım.



Kod:
On Error Resume Next
Set ara = Worksheets("KAYIT").Range("A2:A65536").Find(Worksheets("VERİ GİRİŞİ").Range("[COLOR="Red"]D2[/COLOR]"))
ara.EntireRow.Delete
 
sayın Truvali ben bazen verileri isme göre,noya göre , vb. gibi bir kaç yerden çağırdığım zaman veriler çağrılıyo fakat arşivlemeye gelince veri arşive gönderiliyo ama kayıt bölümündede kalıyo.Ayrıca arşive gönderildikten sonra ana sayfaya dönüş olmuyo .Birde çsğırdığım verinin üzerinde değişiklik yaptığım zaman (No sabit) aynı no nun üzerine kayıt yapmıyo
 
On Error Resume Next
Set ara = Worksheets("KAYIT").Range("A2:A65536").Find(Worksheets("VERİ GİRİŞİ").Range("C2,D2,E2,F2,G2"))
ara.EntireRow.Delete

Sayın Turuvali ben yukarıdaki şekilde yaptım fakat olmadı
 
On Error Resume Next
Set ara = Worksheets("KAYIT").Range("A2:A65536").Find(Worksheets("VERİ GİRİŞİ").Range("C2,D2,E2,F2,G2"))
ara.EntireRow.Delete

Sayın Turuvali ben yukarıdaki şekilde yaptım fakat olmadı

Merhaba,o şekilde olmaz.Eğer başka kriterlere göre de arama yapıyorsanız o dosyayı da ekleyin ona göre cvp veren olur.Yeni örneği ekledim.
 

Ekli dosyalar

Sayın Turuvali emeğiniz için çok teşekkür ederim.
 
Ekteki örnek dosyamda
1- C3,D3,E3,F3,G3,H3 Hücrelerinden çağırdığım verilerinde kayıt bölümünden alınarak arşive gönderilmesi.
2-Verileri hangi hücreden çağırsam o hücredeki değerinaynısı var ise çağırdığım zaman gelemesi ,(Örnek no'dan çağırdığım zaman noda o değer var ise gelsin yok ise gelmesin
3-c3,d3,e3,f3,g3,h3 hücerelerinden herhangi birisinden çağırdığım zamanda kayıttan alınarak arşive gönderilmesi
4-arşive gönderdiğim zaman (c3,d3,e3,g3,h3,d5:d25) hücreleri silinsin arşive gönderildikten sonra tekrar aynı sayfaya geri dönsün(Veri girişi)
 

Ekli dosyalar

Son düzenleme:
Ekteki örnek dosyamda
1- C3,D3,E3,F3,G3,H3 Hücrelerinden çağırdığım verilerinde kayıt bölümünden alınarak arşive gönderilmesi.
2-Verileri hangi hücreden çağırsam o hücredeki değerinaynısı var ise çağırdığım zaman gelemesi ,(Örnek no'dan çağırdığım zaman noda o değer var ise gelsin yok ise gelmesin
3-c3,d3,e3,f3,g3,h3 hücerelerinden herhangi birisinden çağırdığım zamanda kayıttan alınarak arşive gönderilmesi
4-arşive gönderdiğim zaman (c3,d3,e3,g3,h3,d5:d25) hücreleri silinsin arşive gönderildikten sonra tekrar aynı sayfaya geri dönsün(Veri girişi)

Merhaba bu örneğinize de uyarladım.
 

Ekli dosyalar

sayın truvali çağırdığım zaman veriler gelmiyo
 
sayın truvali çağırdığım zaman veriler gelmiyo

Tamam düzelttim örneği umarım bu sefer olmuştur artık.Örneği ekledikten sonra farkettim.Aşağıdaki kodlara kırmızı ile yazılan kodu ilave edersen değiştir ve sil komutlarında da sorun yaşamazsın.

Sub Değiştir()
Dim ara As Range
If Worksheets("VERİ GİRİŞİ").Range("D5").Value = "" Then
MsgBox "LÜTFEN ÖNCE DEĞİŞTİRMEK İSTEDİĞİNİZ VERİYİ ÇAĞIRINIZ"
Exit Sub
Else
Set ara = Worksheets("KAYIT").Range("a2:a65536").Find(Worksheets("VERİ GİRİŞİ").Range("d5").Value)
ara.Offset(0, 0).Value = Worksheets("VERİ GİRİŞİ").Range("d5").Value
ara.Offset(0, 1).Value = Worksheets("VERİ GİRİŞİ").Range("d6").Value
ara.Offset(0, 2).Value = Worksheets("VERİ GİRİŞİ").Range("d7").Value
ara.Offset(0, 3).Value = Worksheets("VERİ GİRİŞİ").Range("d8").Value
ara.Offset(0, 4).Value = Worksheets("VERİ GİRİŞİ").Range("d9").Value
ara.Offset(0, 5).Value = Worksheets("VERİ GİRİŞİ").Range("d10").Value
ara.Offset(0, 6).Value = Worksheets("VERİ GİRİŞİ").Range("d11").Value
ara.Offset(0, 7).Value = Worksheets("VERİ GİRİŞİ").Range("d12").Value
ara.Offset(0, 8).Value = Worksheets("VERİ GİRİŞİ").Range("d13").Value
ara.Offset(0, 9).Value = Worksheets("VERİ GİRİŞİ").Range("d14").Value
MsgBox "VERİ DEĞİŞTİRİLMİŞTİR", vbInformation, "VERİ DEĞİŞTİRME"
End If


End Sub



Sub Sil()
Dim ara As Range
If Worksheets("VERİ GİRİŞİ").Range("D5").Value = "" Then
MsgBox "LÜTFEN ÖNCE SİLMEK İSTEDİĞİNİZ VERİYİ ÇAĞIRINIZ"
Exit Sub
Else
Set ara = Worksheets("KAYIT").Range("a2:a65536").Find(Worksheets("VERİ GİRİŞİ").Range("d5").Value)
ara.EntireRow.Delete
MsgBox "VERİ SİLİNMİŞTİR", vbInformation, "VERİ SİLME"
End If

End Sub
 

Ekli dosyalar

Son düzenleme:
Sayın Turuvali Sil ve Değiştir butonlarında sorun çıkıyo.Örneğin verigişi sayfasında d5 hücresine 3 rakamlı bir sayı yazıp değiştir dediğimde hata veriyo
 
Tamam düzelttim örneği umarım bu sefer olmuştur artık.Örneği ekledikten sonra farkettim.Aşağıdaki kodlara kırmızı ile yazılan kodu ilave edersen değiştir ve sil komutlarında da sorun yaşamazsın.

Sub Değiştir()
Dim ara As Range
If Worksheets("VERİ GİRİŞİ").Range("D5").Value = "" Then
MsgBox "LÜTFEN ÖNCE DEĞİŞTİRMEK İSTEDİĞİNİZ VERİYİ ÇAĞIRINIZ"
Exit Sub
Else
Set ara = Worksheets("KAYIT").Range("a2:a65536").Find(Worksheets("VERİ GİRİŞİ").Range("d5").Value)
ara.Offset(0, 0).Value = Worksheets("VERİ GİRİŞİ").Range("d5").Value
ara.Offset(0, 1).Value = Worksheets("VERİ GİRİŞİ").Range("d6").Value
ara.Offset(0, 2).Value = Worksheets("VERİ GİRİŞİ").Range("d7").Value
ara.Offset(0, 3).Value = Worksheets("VERİ GİRİŞİ").Range("d8").Value
ara.Offset(0, 4).Value = Worksheets("VERİ GİRİŞİ").Range("d9").Value
ara.Offset(0, 5).Value = Worksheets("VERİ GİRİŞİ").Range("d10").Value
ara.Offset(0, 6).Value = Worksheets("VERİ GİRİŞİ").Range("d11").Value
ara.Offset(0, 7).Value = Worksheets("VERİ GİRİŞİ").Range("d12").Value
ara.Offset(0, 8).Value = Worksheets("VERİ GİRİŞİ").Range("d13").Value
ara.Offset(0, 9).Value = Worksheets("VERİ GİRİŞİ").Range("d14").Value
MsgBox "VERİ DEĞİŞTİRİLMİŞTİR", vbInformation, "VERİ DEĞİŞTİRME"
End If


End Sub



Sub Sil()
Dim ara As Range
If Worksheets("VERİ GİRİŞİ").Range("D5").Value = "" Then
MsgBox "LÜTFEN ÖNCE SİLMEK İSTEDİĞİNİZ VERİYİ ÇAĞIRINIZ"
Exit Sub
Else
Set ara = Worksheets("KAYIT").Range("a2:a65536").Find(Worksheets("VERİ GİRİŞİ").Range("d5").Value)
ara.EntireRow.Delete
MsgBox "VERİ SİLİNMİŞTİR", vbInformation, "VERİ SİLME"
End If

End Sub






Sayın Truvali biliyorum sizi bayağı uğraştırdım.Vede bıktırdım.Aklıma birşeyler geldikçe sonradan değiştiriyorum.Sizden Allah razı olsun usanmadan,bıkmadan ve de hiç tepki vermeden yardımcı oluyorsunuz.Ellerinize sağlık.sizden yine çekinerek yardım almak zorunda kaldım.Ekteki örnek dosyamda açıklamalar kısmı ekledim.Verileri çağırıyorum .fakat kayıttan alıp birtürlü arşive gönderemiyorum.dosyayı yeniden düzenleyip gönderirseniz çok makbule geçer
 

Ekli dosyalar

Son düzenleme:
Geri
Üst