üstten alta doğru sıralama

H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
Arkadaşlar ben b9 ,f9 ,h9,k9 ve l9 rakamlar girdiğimde b13 f 13 g13 k13 ve l13 atıyor ve her rakam girdiğinde alt alta sıralıyor. ben en son girdiğim rakamı her zaman en üstte yani b13 f 13 g13 k13 ve l13 yazmasını istiyorum. yani alt alta değilde üstten alta doğru sıralanmasını istiyorum. inşaallah anlatabilmişimdir.emeklerinize sağlık teşekkür ederim...
 

Ekli dosyalar

Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Sayfada koruma var. Parola söyler misiniz?

Lütfen örnek dosyalarınızda önce korumaları kaldırın yada parolayı söyleyin.
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Sayfanın kod kısmında yazan kodları silin aşağıdakileri kopyalayın.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sut = Target.Column + 0
        If Cells(1, sut) = "" Then
            Cells(1, sut) = Target.Value
        Else
            If Cells(Rows.Count, sut) = Empty Then
                Rows("13:13").Insert
                Rows("14:14").Copy
                Rows("13:13").PasteSpecial Paste:=xlPasteFormulas
                Rows("13:13").PasteSpecial Paste:=xlPasteFormats
                Application.CutCopyMode = False
                sat = 12
                Cells(sat + 1, sut) = Target.Value
                If sut = 2 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 6 Then
                    Cells(sat + 1, sut - 2) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 11 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                End If
            Else
                MsgBox Choose(sut / 9, "B", "F", "G", "K", "L") & " Sütunu doldu.", vbCritical
            End If
        End If
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
dalgalikur' Alıntı:
Sayfanın kod kısmında yazan kodları silin aşağıdakileri kopyalayın.

Kod: 
 Özel Alt Çalışma Sayfası_Değiştir (Menzil Olarak ByVal Hedef)
    Kesişiyorsa (Hedef, [B9, f9, g9, k9, l9]) Hiçbir Şey Değil veya Hedef.Cells.Count> 1 Sonra Çıkış
    İptal = Doğru
    Target.Value <> "" Öyleyse
        Target.Select
        Application.EnableEvents = Yanlış
        sut = Hedef.Column + 0
        Hücreler (1, sut) = "" Öyleyse
            Hücreler (1, sut) = Hedef. Değer
        Başka
            Hücreler (Rows.Count, sut) = Boşsa O zaman
                Sıralar ( "13:13"). Yerleştirin
                Sıralar ( "14:14"). Kopya
                Satırlar ("13:13"). PasteÖzel Yapıştır: = xlPasteFormulas
                Satırlar ("13:13"). PasteÖzel Yapıştır: = xlPasteFormats
                Application.CutCopyMode = Yanlış
                oturdu = 12
                Hücreler (sat + 1, sut) = Hedef. Değer
                Sütun = 2 ise
                    Hücreler (sat + 1, sut - 1) = Biçim (Şimdi, "dd.mm.yyyy")
                ElseIf sut = 6 Sonra
                    Hücreler (sat + 1, sut - 2) = Biçim (Şimdi, "dd.mm.yyyy")
                ElseIf sut = 11 Sonra
                    Hücreler (sat + 1, sut - 1) = Biçim (Şimdi, "dd.mm.yyyy")
                Bittiğinde
            Başka
                MsgBox Seçin (sut / 9, "B", "F", "G", "K", "L") ve "Sütunu doldu.", VbCritical
            Bittiğinde
        Bittiğinde
        Target.Value = ""
        Application.EnableEvents = Doğru
    Bittiğinde
Son Alt

[/ KOD] [/ Alıntı]

emeğinize teşekkür ederim.  benim  ABC    DEFGHI    JKLMNO   birbirinden bağımsızlar. B8 rakam girdiğimde enter tuşuna bastığımda bir daha yazmak istediğimde A13 yazıyor B8 sabit olmasını digerleride aynı  bir de örnekte olduğu gibi çifter çifter yazıyor fındık satışta  gelen fındıkta aynı proplemler var.ilgilenirseniz memnun olurum.teşekkürler  fatura kısmın hepsini  elle dolduruyorum
Genişletmek için tıkla ...
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
[QUOTE = "hüseyin551, gönderi: 1009192, üye: 398637"] [/ QUOTE]
 

Ekli dosyalar

Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Kodları düzelttim şimdi tekrar deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sut = Target.Column + 0
        If Cells(1, sut) = "" Then
            Cells(1, sut) = Target.Value
        Else
            If Cells(Rows.Count, sut) = Empty Then
                If Not Intersect(Target, [B9]) Is Nothing Then
                    Rows("13:13").Insert
                    Rows("14:14").Copy
                    Rows("13:13").PasteSpecial Paste:=xlPasteFormulas
                    Rows("13:13").PasteSpecial Paste:=xlPasteFormats
                    Application.CutCopyMode = False
                End If
                sat = 12
                Cells(sat + 1, sut) = Target.Value
                If sut = 2 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 6 Then
                    Cells(sat + 1, sut - 2) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 11 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                End If
            Else
                MsgBox Choose(sut / 9, "B", "F", "G", "K", "L") & " Sütunu doldu.", vbCritical
            End If
        End If
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
dalgalikur' Alıntı:
Kodları düzelttim şimdi tekrar deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sut = Target.Column + 0
        If Cells(1, sut) = "" Then
            Cells(1, sut) = Target.Value
        Else
            If Cells(Rows.Count, sut) = Empty Then
                If Not Intersect(Target, [B9]) Is Nothing Then
                    Rows("13:13").Insert
                    Rows("14:14").Copy
                    Rows("13:13").PasteSpecial Paste:=xlPasteFormulas
                    Satırlar ("13:13"). PasteÖzel Yapıştır: = xlPasteFormats
                    Application.CutCopyMode = Yanlış
                Bittiğinde
                oturdu = 12
                Hücreler (sat + 1, sut) = Hedef. Değer
                Sütun = 2 ise
                    Hücreler (sat + 1, sut - 1) = Biçim (Şimdi, "dd.mm.yyyy")
                ElseIf sut = 6 Sonra
                    Hücreler (sat + 1, sut - 2) = Biçim (Şimdi, "dd.mm.yyyy")
                ElseIf sut = 11 Sonra
                    Hücreler (sat + 1, sut - 1) = Biçim (Şimdi, "dd.mm.yyyy")
                Bittiğinde
            Başka
                MsgBox Seçin (sut / 9, "B", "F", "G", "K", "L") ve "Sütunu doldu.", VbCritical
            Bittiğinde
        Bittiğinde
        Target.Value = ""
        Application.EnableEvents = Doğru
    Bittiğinde
Son Alt
[/ KOD] [/ Alıntı]


B8  veri girdiğimde enterdan sonra yine a13 atıyor.  fındık satış  ve gelen fındık hep  13.satıra yazıyor 14.satıra devretmiyor .size zahmet ettim.teşekkürler
Genişletmek için tıkla ...
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Şimdi oldu herhalde.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sut = Target.Column + 0
        If Cells(1, sut) = "" Then
            Cells(1, sut) = Target.Value
        Else
            If Cells(Rows.Count, sut) = Empty Then
                If Not Intersect(Target, [B9]) Is Nothing Then
                    Rows("13:13").Insert
                    Rows("14:14").Copy
                    Rows("13:13").PasteSpecial Paste:=xlPasteFormats
                    Application.CutCopyMode = False
                    Range("C14").Copy Range("C13")
                    Range("E14").Copy Range("E13")
                    Range("H14:I14").Copy Range("H13")
                    Range("M14:O14").Copy Range("M13")
                    Range("T14:U14").Copy Range("T13")
                End If
                sat = 12
                Cells(sat + 1, sut) = Target.Value
                If sut = 2 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 6 Then
                    Cells(sat + 1, sut - 2) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 11 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                End If
            Else
                MsgBox Choose(sut / 9, "B", "F", "G", "K", "L") & " Sütunu doldu.", vbCritical
            End If
        End If
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
verileri üst üste yazıyor
 

Ekli dosyalar

Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Tekrar dener misiniz?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As String
    If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Cancel = True
    If Target.Value <> "" Then
        Target.Select
        Application.EnableEvents = False
        sut = Target.Column + 0
        If Cells(1, sut) = "" Then
            Cells(1, sut) = Target.Value
        Else
            If Cells(Rows.Count, sut) = Empty Then
                If Not Intersect(Target, [B9]) Is Nothing Then
                    Alan = "A13:C13"
                ElseIf Not Intersect(Target, [F9]) Is Nothing Then
                    Alan = "D13:I13"
                ElseIf Not Intersect(Target, [K9]) Is Nothing Then
                    Alan = "J13:O13"
                End If
                If Not Intersect(Target, [B9,F9,K9]) Is Nothing Then
                    Range(Alan).Insert Shift:=xlDown
                    Rows("14:14").Copy
                    Rows("13:13").PasteSpecial Paste:=xlPasteFormats
                    Application.CutCopyMode = False
                    Range("C14").Copy Range("C13")
                    Range("E14").Copy Range("E13")
                    Range("H14:I14").Copy Range("H13")
                    Range("M14:O14").Copy Range("M13")
                    Range("T14:U14").Copy Range("T13")
                End If
                sat = 12
                Cells(sat + 1, sut) = Target.Value
                If sut = 2 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 6 Then
                    Cells(sat + 1, sut - 2) = Format(Now, "dd.mm.yyyy")
                ElseIf sut = 11 Then
                    Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
                End If
            Else
                MsgBox Choose(sut / 9, "B", "F", "G", "K", "L") & " Sütunu doldu.", vbCritical
            End If
        End If
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
size zahmet veriyorum hakkını helal et. şimde b9 ,f9,g9,k9 ve l9 veri girip enter değim de istediklerim oluyor ama ikince veri girince a13 yazıyor hepsi (b9 ,f9,g9,k9 ve l9) .sabit kalmasını istiyorum
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
bir de c e h k m ve n sutununda buluman genel toplamlarımı yapamıyorum misal c14 satırında olan =b14+c13 formulleri aşağıya dogru çektim. özür borçluyum çok çok zahmet veriyorum
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Sadece şu üç soruyu cevaplar mısınız?
1-B9'a örneğin 1 yazdım entere bastım ne olsun?
2-Daha sonra yine B9'a örneğin 5 yazdım entere bastım ne olsun?
3-Daha sonra yine 3. kez B9'a örneğin 8 yazdım entere bastım ne olsun?
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
B9 a 1 yazıp enter dediğimde B9 da kalsın ikinci veri yazmak için (enter dediğimde A13 atıyor)
birde genel toplamları vermiyor. çok çok özür dilerim
 
Muzaffer Ali

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Genel toplamlar nerede yazıyor?
Genel yada Toplam başlıkları bulamadım.
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
C10,E10,I10,K10,M10,O10 larda var.örnek olarak C14=B14+C13 yapıp aşağıya sürükledim. e topladım .c10 lara da köprü ile aldım.
 
H

hüseyin551

Katılım
4 Haziran 2017
Mesajlar
158
Excel Vers. ve Dili
Microsoft Excel 2010 TR
Altın Üyelik Bitiş Tarihi
21-10-2024
Hocam sizi çok uğraştırdım.Tabiki ben derdimi anlatamadım.hakkını helal et.İstediğim gibi oldu.emeğinize sağlık.veri girdiğimde enter dediğimde titreme yapıyor bu normalmidir? .bir de bu sayfadan taşı ve kopyalamadan 200 sayfa yapaçağim bir sorun yaşar mıyım? herşey için TEŞEKKÜR EDERİM.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst