Soru Şarta bağlı olarak üst satırdan alt satıra veri kopyalanması

[mybluecat]

Tekrar merhaba,
Ekteki dosya da değerli kullanıcıların yardımları sayesinde yapmak istediğim düzenlemeler büyük ölçüde gerçekleşti. Bir iki eksik kısım var.
Dosyada B sütununa veri girişi yapıldığında, bir üst satırdaki D sütunundan AW sütununa kadar olan formülleri bir alt satıra kopyalıyor ve üst satırdaki formülleri sabit veriye dönüştürüyor.
Bu noktada bir kaç düzeltmeye ihtiyacım var;
1) B sütununa aynı anda birden fazla veri girişi yapıldığında alt satıra formüller gelmiyor
2) Kod üst satırı hücre yapıları ile birlikte kopyalayıp alt satıra yapıştırıyor.Bunun yerine sadece hücre içindeki formülü yapıştırması gerekiyor.
3) Üst satırlarda bulunan o güne ait formüllerin ertesi güne geçildiğinde C sütunundaki tarih değişikliğini baz alarak veri haline dönüşmesi gerekiyor.Yani bugün girilen örneğin 40 satır verinin yarın C sütununda 1/09/20 tarihi göründüğünde sabit hale gelmesi gerekiyor.
4) B sütununa hatalı veri girişi yapıldığında satıra otomatik gelen bilgiler, hatalı veri silinse bile gitmiyor.

Yardımlarınızı bekliyor, teşekkür ediyorum..

 

[mybluecat]

Bu foruma ne zaman üye olduysam , ilk zamanlar sorulara dönüş alıyorum. Bir süre sonra hiç yanıt alamaz oluyorum. Yardım istediğim konular mı çözümsüz , benim mi bir hatam var anlamıyorum.

 

[mybluecat]

Tekrar merhaba,
31 Ağustos'ta sorduğum soruya cevap alamadığım için tekrar sormak istedim.( Belki çözümü yoktur )

Ekteki dosya da değerli kullanıcıların yardımları sayesinde yapmak istediğim düzenlemeler büyük ölçüde gerçekleşti. Bir iki eksik kısım var.
Dosyada B sütununa veri girişi yapıldığında, bir üst satırdaki D sütunundan AW sütununa kadar olan formülleri bir alt satıra kopyalıyor ve üst satırdaki formülleri sabit veriye dönüştürüyor.
Bu noktada bir kaç düzeltmeye ihtiyacım var;
1) B sütununa aynı anda birden fazla veri girişi yapıldığında alt satıra formüller gelmiyor
2) Kod üst satırı hücre yapıları ile birlikte kopyalayıp alt satıra yapıştırıyor.Bunun yerine sadece hücre içindeki formülü yapıştırması gerekiyor.
3) Üst satırlarda bulunan o güne ait formüllerin ertesi güne geçildiğinde C sütunundaki tarih değişikliğini baz alarak veri haline dönüşmesi gerekiyor.Yani bugün girilen örneğin 40 satır verinin yarın C sütununda 1/09/20 tarihi göründüğünde sabit hale gelmesi gerekiyor.
4) B sütununa hatalı veri girişi yapıldığında satıra otomatik gelen bilgiler, hatalı veri silinse bile gitmiyor.

Yardımlarınızı bekliyor, teşekkür ediyorum..

 

[Muzaffer Ali]

Merhaba.
Dosyanızda VBA kodları mevcut. Formül kopylaması VBA kodları ile yapılıyor ve siliniyor. Demek ki formüle daha sonra ihtiyaç yok.
Madem öyle neden formül kopyalanıyor? Bunun yerine formüllerde yapılan hesaplamalar neden VBA kodları ile yapılmıyor?
Eğer özel bir sebebi yoksa B sütununa bir veri girildiğinde çalışan VBA kodlarının formül kopyalamak yerine hesaplama yaparak gerekli hücrelere yazmasını sağlamak daha doğru olur.

"Numune Kayıt Kabul" adlı sayfadaki kodları silin aşağıdakileri kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    Dim No As String
    Application.EnableEvents = False
    If Not Intersect(Target, Range("B6:B" & Rows.Count)) Is Nothing Then
        If Target.Text = "" Then
            Range("C" & Target.Row & ":AW" & Target.Row).ClearContents
        Else
            
            Set Bul = Worksheets("ANALİZLER").Range("B:B").Find(Target.Text, LookAt:=xlWhole)
            If Bul Is Nothing Then
                Range("C" & Target.Row & ":AT" & Target.Row) = "BULUNAMADI"
            Else
                Cells(Target.Row, "C") = Date
                Cells(Target.Row, "E") = Time
                No = Format(Date, "yy") & Format(Date, "MM") & Format(Date, "dd") & Right("000" & Cells(Target.Row, "A"), 4)
                Cells(Target.Row, "F") = No
                Worksheets("ANALİZLER").Range("F" & Bul.Row & ":AT" & Bul.Row).Copy Cells(Target.Row, "G")
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[mybluecat]

Elinize sağlık
Yanıtınızı yeni gördüm. Bu çok daha iyi bir yol. Sadece sildiğim kodlar içinde F sütunundaki rakamları oluşturan bir kod vardı.O kodu sizin yaptığınız kod ile beraber kullanabilirsem harika olacak. Hangi kod olduğunu ekteki dosyadan siz anlayabilirsiniz sanırım.

 

[Muzaffer Ali]

Merhaba.
Kodu denediniz mi?
Zaten F sütunundaki kodu da oluşturuyor.

 

[mybluecat]

Anlatması biraz karışık olduğu için geçmişteki kodu sizin yaptığınız kod ile birleştirmek istedim.
Sizin kodunuz da F sütunu için çalışıyor ama tam olarak değil. Şöyle anlatmaya çalışayım.
F sütununda oluşan sayı örneğin 2009110050 olsun. Bu sayıda ki 20 = yıl , 09=Ay 11=Gün 0050= Ayın ilk gününden bugüne kadar girilen veri sayısı. Her veri girişin de bu sayı o ay bitene kadar artar. Ancak bir sonraki aya geçildiğinde son dört rakam tekrar 0001 şeklinde başlamalı. Yani her ay son dört rakam sıfırlanmalı. Sizin kod ilk kısmı yapabiliyor. Ancak diğer aya geçildiğinde sifirlamadan uzerine saymaya devam ediyor. Ekte ki dosya bulunan kod bunu yapabiliyordu. Kod dan anlamadığım için hangisi bilmiyorum.

 

[Muzaffer Ali]

Tamam şimdi anladım.
Deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    Dim No As String
    Dim Bak As Long
    Application.EnableEvents = False
    If Not Intersect(Target, Range("B6:B" & Rows.Count)) Is Nothing Then
        If Target.Text = "" Then
            Range("C" & Target.Row & ":AW" & Target.Row).ClearContents
        Else
            
            Set Bul = Worksheets("ANALİZLER").Range("B:B").Find(Target.Text, LookAt:=xlWhole)
            If Bul Is Nothing Then
                Range("C" & Target.Row & ":AT" & Target.Row) = "BULUNAMADI"
            Else
                Cells(Target.Row, "C") = Date
                Cells(Target.Row, "E") = Time
                No = 1
                For Bak = 7 To Cells(Rows.Count, "C").End(xlUp).Row
                    If Month(Cells(Bak, "C")) = Month(Cells(Bak - 1, "C")) Then
                        No = 1 + No
                    Else
                        No = 1
                    End If
                Next
                No = Right("000" & No, 4)
                No = Format(Date, "yy") & Format(Date, "MM") & Format(Date, "dd") & No
                Cells(Target.Row, "F") = No
                Worksheets("ANALİZLER").Range("F" & Bul.Row & ":AT" & Bul.Row).Copy Cells(Target.Row, "G")
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[mybluecat]

Evet ay değişimlerinde son dört rakam tekrar 1 den başlıyor. Denemem de bir kaç sorun fark ettim. B sütununa tek tek veri girildiğinde sistem çalışıyor. Fakat birden fazla veriyi aynı anda kopyala yapıştır yaptığımda hata veriyor. Bir de kod girilen veriye karşılık bir değer bulamadığında "Bulunamadı" yazıyor hücrede. Bu yazının gelmemesi mümkün mü?

 

[Muzaffer Ali]

Buyurun.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    Dim No As String
    Dim Bak As Long
    Dim Target_ As Range
    Application.EnableEvents = False
    For Each Target_ In Target

        If Not Intersect(Target_, Range("B6:B" & Rows.Count)) Is Nothing Then
            If Target_.Text = "" Then
                Range("C" & Target_.Row & ":AW" & Target_.Row).ClearContents
            Else
                
                Set Bul = Worksheets("ANALİZLER").Range("B:B").Find(Target_.Text, LookAt:=xlWhole)
                If Bul Is Nothing Then
                    Range("C" & Target_.Row & ":AT" & Target_.Row) = "BULUNAMADI"
                Else
                    Cells(Target_.Row, "C") = Date
                    Cells(Target_.Row, "E") = Time
                    No = 1
                    For Bak = 7 To Cells(Rows.Count, "C").End(xlUp).Row
                        If Month(Cells(Bak, "C")) = Month(Cells(Bak - 1, "C")) Then
                            No = 1 + No
                        Else
                            No = 1
                        End If
                    Next
                    No = Right("000" & No, 4)
                    No = Format(Date, "yy") & Format(Date, "MM") & Format(Date, "dd") & No
                    Cells(Target_.Row, "F") = No
                    Worksheets("ANALİZLER").Range("F" & Bul.Row & ":AT" & Bul.Row).Copy Cells(Target_.Row, "G")
                End If
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub

BULUNAMADI yerine ne yazmasını istiyorsanız kod içerisinde kendiniz de değiştirebilirsiniz.
Hiçbir şey yazmasını istemezseniz = "" yazabilirsiniz.

 

[mybluecat]

Çok teşekkür ederim. Elinize sağlık. Harika olmuş .... Son bir sorum olacak. Bu kodun bir satır sınırı var mı? Kullanacağım tabloda 30.000 satıra kadar ineceğim çünkü.

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.

İlk 5 satır hariç çalışır.
B6 Hücresinden başlayarak B sütununun en son satırına kadar kullanılabilir.
Deneyerek görebilirsiniz.

 

[mybluecat]

Teşekkürler