Çözüldü Bir sonraki sayıyı otomatik eklesin

By.TRabZonLutm · 18 Kasım 2024

Merhaba arkadaşlar. Derece kademe 12 den başlıyor 1’e kadar yükseliyor. 11/1 - 11/2 - 11/3 ardindan 10/1 - 10/2 - 10-3 ..... bu şekilde 1/1 - 1/2 - 1/3 - 1/4 sadece birince derecede 4 kademe var. Ben bir hücreye örneğin 10/1 yazınca yanındaki hücreye otomatik 10/2 yazsın istiyorum. Aynı şekilde 9/3 yazınca bir sonraki yükselme 8/1 olacağı için o şekilde yazsın istiyorum. Ama tek kıstas 1/3 olunca 1/4 yazsın. Yukarıda yazdığım gibi birinci derecede 4 kademe var. Nasıl yapabilirim. Teşekkür ediyorum

Trilenium · 18 Kasım 2024

11/1 yazarsanız bunu tarih olarak algılar.. o yüzden değeri yazacağınız alana '11/1 gibi yazmalısınız. veya hücreyi texte çevirin

İngilizce formül
=IF(A2="";"";IF(AND(INT(LEFT(A2;FIND("/";A2)-1))=1;RIGHT(A2;1)=3);"1/4";IF(RIGHT(A2;1)=3;(INT(LEFT(A2;FIND("/";A2)-1))-1)&"/1";LEFT(A2;FIND("/";A2)-1)&"/"&(RIGHT(A2;1)+1))))

Türkçe formül

=EĞER(A2="";"";EĞER(VE(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))=1;PARÇAAL(A2;BUL("/";A2)+1;UZUNLUK(A2)-BUL("/";A2))=3);"1/4";EĞER(PARÇAAL(A2;BUL("/";A2)+1;UZUNLUK(A2)-BUL("/";A2))=3;(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))-1)&"/1";PARÇAAL(A2;1;BUL("/";A2)-1)&"/"&(PARÇAAL(A2;BUL("/";A2)+1;UZUNLUK(A2)-BUL("/";A2))+1))))

tugkan · 18 Kasım 2024

Merhaba,
Alternatif makrolu çözüm.

Derece ve kademeyi yazdığınızda makro kullanarak bir hücreye değer girildiğinde veya değiştirildiğinde tetiklenir.

Adımlar:

Excel'de VBA Düzenleyicisi'ni açın:
- Alt + F11 tuşlarına basın.
Kodun Yapıştırılacağı Yeri Seçin:
- Sol taraftaki proje penceresinde, değiştirmek istediğiniz çalışma sayfasının adına çift tıklayın (örneğin, Sheet1).
Aşağıdaki Kodları Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim giris As String
    Dim derece As Integer, kademe As Integer
    Dim sonuc As String

    ' Hedef hücreyi kontrol et (örneğin, yalnızca A sütununda işlem yapacak)
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        ' Tek bir hücrede işlem yapılmış mı?
        If Target.Cells.Count > 1 Then Exit Sub

        ' Girilen değeri al
        giris = Target.Value

        ' Derece ve kademe ayırma kontrolü
        On Error Resume Next
        derece = Split(giris, "/")(0)
        kademe = Split(giris, "/")(1)
        On Error GoTo 0
        
        ' Geçerli format kontrolü
        If IsNumeric(derece) And IsNumeric(kademe) Then
            If derece >= 1 And derece <= 12 And kademe >= 1 And kademe <= 4 Then
                ' Kademe artırma ve dereceyi düşürme işlemi
                If derece = 1 And kademe = 4 Then
                    MsgBox "1/4 son derece ve kademedir.", vbExclamation
                    Exit Sub
                ElseIf kademe < 4 Then
                    kademe = kademe + 1
                Else
                    kademe = 1
                    derece = derece - 1
                End If

                ' Yeni derece/kademe oluştur
                sonuc = derece & "/" & kademe
                
                ' Hücreleri "Metin" olarak biçimlendir
                Application.EnableEvents = False
                Target.NumberFormat = "@"
                Target.Offset(0, 1).NumberFormat = "@"

                ' Sonucu yan hücreye yaz
                Target.Offset(0, 1).Value = sonuc
                Application.EnableEvents = True
            Else
                MsgBox "Geçerli bir derece/kademe girin (örneğin, 10/1).", vbExclamation
            End If
        End If
    End If
End Sub

Kod Açıklamaları:

Metin Biçimlendirme:
- Target.NumberFormat = "@" ve Target.Offset(0, 1).NumberFormat = "@" kodları, yazılan ve sonuçların yazıldığı hücreleri "Metin" olarak biçimlendirir.
1. Derecede 4 Kademe:
- Kod, kademe = 4 olduğunda doğru bir şekilde 1/4 olarak günceller.
Kontrol:
- Hücredeki format uygun değilse veya yanlış giriş yapılırsa kullanıcı uyarılır.

Kullanım:

A sütunundaki hücrelere değer yazın (örneğin, 10/1).
Enter tuşuna bastığınızda, ilgili değer otomatik olarak hesaplanır ve yanındaki hücreye yazılır.

By.TRabZonLutm · 18 Kasım 2024

Trilenium' Alıntı:
11/1 yazarsanız bunu tarih olarak algılar.. o yüzden değeri yazacağınız alana '11/1 gibi yazmalısınız. veya hücreyi texte çevirin

İngilizce formül
=IF(A2="";"";IF(AND(INT(LEFT(A2;FIND("/";A2)-1))=1;RIGHT(A2;1)=3);"1/4";IF(RIGHT(A2;1)=3;(INT(LEFT(A2;FIND("/";A2)-1))-1)&"/1";LEFT(A2;FIND("/";A2)-1)&"/"&(RIGHT(A2;1)+1))))

Türkçe formül

=EĞER(A2="";"";EĞER(VE(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))=1;PARÇAAL(A2;BUL("/";A2)+1;UZUNLUK(A2)-BUL("/";A2))=3);"1/4";EĞER(PARÇAAL(A2;BUL("/";A2)+1;UZUNLUK(A2)-BUL("/";A2))=3;(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))-1)&"/1";PARÇAAL(A2;1;BUL("/";A2)-1)&"/"&(PARÇAAL(A2;BUL("/";A2)+1;UZUNLUK(A2)-BUL("/";A2))+1))))

İlginize teşekkür ediyorum. Şöyle bir problem var . 10/3 yazınca 9/1 e yukseltmiyor. 10/4 10/5 şeklinde devam ediyor hocam. 11 - 10 -9 ..... 2/1 2/2 2/3 .... Üçüncü kademeye kadar. 1/1 1/2 1/3 1/4 ise dördüncü kademeye kadar ilerlemesini istiyordum hocam

Trilenium · 18 Kasım 2024

Derece kademe 12 den başlıyor 1’e kadar yükseliyor. 11/1 - 11/2 - 11/3 ardindan 10/1 - 10/2 - 10-3 .....

Bunu siz yazmıştınız sanırım.

10/3 yazınca 9/1 dememişsiniz.

Kademeleri bir tablo halinde sunabilir misiniz.

By.TRabZonLutm · 18 Kasım 2024

Hocam şu şekilde
12/1 12/2 12/3
11/1 11/2 11/3
../.. ../.. ../..
2/1 2/2 2/3
1/1 1/2 1/3 1/4

By.TRabZonLutm · 18 Kasım 2024

Trilenium' Alıntı:
Derece kademe 12 den başlıyor 1’e kadar yükseliyor. 11/1 - 11/2 - 11/3 ardindan 10/1 - 10/2 - 10-3 .....

Bunu siz yazmıştınız sanırım.

10/3 yazınca 9/1 dememişsiniz.

Kademeleri bir tablo halinde sunabilir misiniz.

12/3 ten sonra 11/1 geliyor. Yani son rakam üç olunca . Yeni rakam / işaretinin solu ve sağındaki rakam da değişiyor. Sol bir sonraki rakam oluyor. Sağ ise 1 oluyor

Trilenium · 18 Kasım 2024

Benim kafam karıştı.

Şu an diyorsunuz ki en son rakam 3 yukarı da diyorsunuz ki "10/3 yazınca 9/1 e yukseltmiyor. 10/4 10/5 şeklinde devam ediyor hocam. 11 - 10 -9 ..... 2/1 2/2 2/3 .... Üçüncü kademeye kadar. 1/1 1/2 1/3 1/4 i"

By.TRabZonLutm · 18 Kasım 2024

Trilenium' Alıntı:
Benim kafam karıştı.

Şu an diyorsunuz ki en son rakam 3 yukarı da diyorsunuz ki "10/3 yazınca 9/1 e yukseltmiyor. 10/4 10/5 şeklinde devam ediyor hocam. 11 - 10 -9 ..... 2/1 2/2 2/3 .... Üçüncü kademeye kadar. 1/1 1/2 1/3 1/4 i"

Yükseltme aşağı doğru oluyor hocam. 10/3 ten sonra 9/1 geliyor. 9/2 9/3 sekilde gidiyor. 9/3 ten sonra 8/1 geliyor. 2/3 ten sonra 1/1 1/2 1/3 1/4 son oluyor. Sizin verdiğiniz formülde 10/3 ten sonra 10/4 yazıyor. Test için 10/4 girdiğimde 10/5 yazıyor

Trilenium · 18 Kasım 2024

İngilizce
=IF(A2="";"";IF(AND(INT(LEFT(A2;FIND("/";A2)-1))=1;VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))=3);"1/4";IF(AND(INT(LEFT(A2;FIND("/";A2)-1))=1;VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))=4);"";IF(VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))=3;(INT(LEFT(A2;FIND("/";A2)-1))-1)&"/1";LEFT(A2;FIND("/";A2)-1)&"/"&(VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))+1)))))

Türkçe
=EĞER(A2="";"";EĞER(VE(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))=1;DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))=3);"1/4";EĞER(VE(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))=1;DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))=4);"";EĞER(DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))=3;(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))-1)&"/1";PARÇAAL(A2;1;BUL("/";A2)-1)&"/"&(DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))+1)))))

Necdet · 18 Kasım 2024

Merhaba,
Pratik yöntem. Alternatif olsun. Dosyayı inceleyiniz.

md3m1ray · 18 Kasım 2024

tugkan' Alıntı:
Merhaba,
Alternatif makrolu çözüm.

Derece ve kademeyi yazdığınızda makro kullanarak bir hücreye değer girildiğinde veya değiştirildiğinde tetiklenir.

Adımlar:

Excel'de VBA Düzenleyicisi'ni açın:

Alt + F11 tuşlarına basın.

Kodun Yapıştırılacağı Yeri Seçin:

Sol taraftaki proje penceresinde, değiştirmek istediğiniz çalışma sayfasının adına çift tıklayın (örneğin, Sheet1).

Aşağıdaki Kodları Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range) Dim giris As String Dim derece As Integer, kademe As Integer Dim sonuc As String ' Hedef hücreyi kontrol et (örneğin, yalnızca A sütununda işlem yapacak) If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then ' Tek bir hücrede işlem yapılmış mı? If Target.Cells.Count > 1 Then Exit Sub ' Girilen değeri al giris = Target.Value ' Derece ve kademe ayırma kontrolü On Error Resume Next derece = Split(giris, "/")(0) kademe = Split(giris, "/")(1) On Error GoTo 0 ' Geçerli format kontrolü If IsNumeric(derece) And IsNumeric(kademe) Then If derece >= 1 And derece <= 12 And kademe >= 1 And kademe <= 4 Then ' Kademe artırma ve dereceyi düşürme işlemi If derece = 1 And kademe = 4 Then MsgBox "1/4 son derece ve kademedir.", vbExclamation Exit Sub ElseIf kademe < 4 Then kademe = kademe + 1 Else kademe = 1 derece = derece - 1 End If ' Yeni derece/kademe oluştur sonuc = derece & "/" & kademe ' Hücreleri "Metin" olarak biçimlendir Application.EnableEvents = False Target.NumberFormat = "@" Target.Offset(0, 1).NumberFormat = "@" ' Sonucu yan hücreye yaz Target.Offset(0, 1).Value = sonuc Application.EnableEvents = True Else MsgBox "Geçerli bir derece/kademe girin (örneğin, 10/1).", vbExclamation End If End If End If End Sub

Kod Açıklamaları:

Metin Biçimlendirme:

Target.NumberFormat = "@" ve Target.Offset(0, 1).NumberFormat = "@" kodları, yazılan ve sonuçların yazıldığı hücreleri "Metin" olarak biçimlendirir.

1. Derecede 4 Kademe:

Kod, kademe = 4 olduğunda doğru bir şekilde 1/4 olarak günceller.

Kontrol:

Hücredeki format uygun değilse veya yanlış giriş yapılırsa kullanıcı uyarılır.

Kullanım:

A sütunundaki hücrelere değer yazın (örneğin, 10/1).

Enter tuşuna bastığınızda, ilgili değer otomatik olarak hesaplanır ve yanındaki hücreye yazılır.

tugkan hocanın kodunu sonra kullanmak için arşive ekleyecektim ancak sadece 1. derecede 4. kademe olabileceği için sadece o kısmı bu şekilde düzelttim kendime göre.. teşekkürler

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim giris As String
    Dim derece As Integer, kademe As Integer
    Dim sonuc As String

    ' Hedef hücreyi kontrol et (örneğin, yalnızca A sütununda işlem yapacak)
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        ' Tek bir hücrede işlem yapılmış mı?
        If Target.Cells.Count > 1 Then Exit Sub

        ' Girilen değeri al
        giris = Target.Value

        ' Derece ve kademe ayırma kontrolü
        On Error Resume Next
        derece = Split(giris, "/")(0)
        kademe = Split(giris, "/")(1)
        On Error GoTo 0
        
        ' Geçerli format kontrolü
        If IsNumeric(derece) And IsNumeric(kademe) Then
            If derece >= 2 And derece <= 12 And kademe >= 1 And kademe <= 3 Then
                ' Kademe artırma ve dereceyi düşürme işlemi
                If kademe < 3 Then
                    kademe = kademe + 1
                Else
                    kademe = 1
                    derece = derece - 1
                End If

                ' Yeni derece/kademe oluştur
                sonuc = derece & "/" & kademe
                
                ' Hücreleri "Metin" olarak biçimlendir
                Application.EnableEvents = False
                Target.NumberFormat = "@"
                Target.Offset(0, 1).NumberFormat = "@"

                ' Sonucu yan hücreye yaz
                Target.Offset(0, 1).Value = sonuc
                Application.EnableEvents = True
            
            ElseIf derece = 1 And kademe >= 1 And kademe <= 4 Then
                If derece = 1 And kademe = 4 Then
                    kademe = 4
                    derece = 1
                Else
                    kademe = kademe + 1
                    derece = 1
                End If
                
                ' Yeni derece/kademe oluştur
                sonuc = derece & "/" & kademe
                
                ' Hücreleri "Metin" olarak biçimlendir
                Application.EnableEvents = False
                Target.NumberFormat = "@"
                Target.Offset(0, 1).NumberFormat = "@"

                ' Sonucu yan hücreye yaz
                Target.Offset(0, 1).Value = sonuc
                Application.EnableEvents = True

            Else
                MsgBox "Geçerli bir derece/kademe girin (örneğin, 10/1).", vbExclamation
            End If
        End If
    End If
End Sub

By.TRabZonLutm · 18 Kasım 2024

Trilenium' Alıntı:
İngilizce
=IF(A2="";"";IF(AND(INT(LEFT(A2;FIND("/";A2)-1))=1;VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))=3);"1/4";IF(AND(INT(LEFT(A2;FIND("/";A2)-1))=1;VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))=4);"";IF(VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))=3;(INT(LEFT(A2;FIND("/";A2)-1))-1)&"/1";LEFT(A2;FIND("/";A2)-1)&"/"&(VALUE(RIGHT(A2;LEN(A2)-FIND("/";A2)))+1)))))

Türkçe
=EĞER(A2="";"";EĞER(VE(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))=1;DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))=3);"1/4";EĞER(VE(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))=1;DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))=4);"";EĞER(DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))=3;(TAMSAYI(PARÇAAL(A2;1;BUL("/";A2)-1))-1)&"/1";PARÇAAL(A2;1;BUL("/";A2)-1)&"/"&(DEĞER(PARÇAAL(A2;UZUNLUK(A2)-BUL("/";A2)))+1)))))

Hocam şöyle diyor.
Bu işlev için çok fazla bağımsız bir değişken girdiniz.

By.TRabZonLutm · 18 Kasım 2024

Necdet' Alıntı:
Merhaba,
Pratik yöntem. Alternatif olsun. Dosyayı inceleyiniz.

Pratik gerçekten , teşekkür ediyorum. Bunu da ekledim

tugkan · 18 Kasım 2024

Her derecede üç kademe var, sadece 1. derecede dört kademe var.
Derece ve kademe mantığına uygun şekilde yükseltiliyor.

Güncel Kod:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim giris As String
    Dim derece As Integer, kademe As Integer
    Dim sonuc As String

    ' Yalnızca A sütununda işlem yapılmasını sağla
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        ' Birden fazla hücre değiştirilmişse işlem yapma
        If Target.Cells.Count > 1 Then Exit Sub

        ' Girilen değeri al
        giris = Target.Value

        ' Derece ve kademe ayırma kontrolü
        On Error Resume Next
        derece = Split(giris, "/")(0)
        kademe = Split(giris, "/")(1)
        On Error GoTo 0

        ' Geçerli format kontrolü
        If IsNumeric(derece) And IsNumeric(kademe) Then
            ' Derece ve kademe sınırları
            If derece >= 1 And derece <= 12 And kademe >= 1 And kademe <= 4 Then
                ' Kademe artırma ve derece düşürme mantığı
                If derece = 1 And kademe = 4 Then
                    MsgBox "1/4 son derece ve kademedir.", vbExclamation
                    Exit Sub
                ElseIf derece > 1 And kademe < 3 Then
                    ' Derece > 1 ise ve kademe < 3 ise sadece kademe artır
                    kademe = kademe + 1
                ElseIf derece > 1 And kademe = 3 Then
                    ' Derece > 1 ve kademe 3 olduğunda, dereceyi bir azalt, kademe 1 yap
                    derece = derece - 1
                    kademe = 1
                ElseIf derece = 1 And kademe < 4 Then
                    ' Derece = 1 olduğunda kademe 4'e kadar artır
                    kademe = kademe + 1
                End If

                ' Yeni derece/kademe oluştur
                sonuc = derece & "/" & kademe

                ' Hücreleri "Metin" olarak biçimlendir
                Application.EnableEvents = False
                Target.NumberFormat = "@"
                Target.Offset(0, 1).NumberFormat = "@"

                ' Sonucu yan hücreye yaz
                Target.Offset(0, 1).Value = sonuc
                Application.EnableEvents = True
            Else
                MsgBox "Geçerli bir derece/kademe girin (örneğin, 10/1).", vbExclamation
            End If
        End If
    End If
End Sub

Kodun Çalışma Mantığı:

Derece ve Kademe Mantığı:
- Derece 1 ise: Kademe 4’e kadar çıkar, sonra durur.
- Derece 2 ile 12 arasında ise: Kademe 3’e kadar çıkar, sonra bir üst dereceye geçer.
Geçersiz Değer Kontrolü:
- Girişin geçerli bir format olup olmadığını kontrol eder (n/n formatında olmalı).
Hücreleri Metin Formatına Çevirme:
- Hem yazılan hücre hem de sonuç hücresini otomatik olarak "Metin" biçimine çevirir.

Kullanım:

A sütununda bir hücreye derece/kademe yazın (örneğin, 10/3).
Enter tuşuna bastığınızda:
- Yanındaki hücrede bir sonraki derece/kademe otomatik olarak hesaplanır.
- Örneğin: 10/3 yazarsanız 9/1 yan hücreye yazılacaktır.

By.TRabZonLutm · 18 Kasım 2024

tugkan' Alıntı:

Her derecede üç kademe var, sadece 1. derecede dört kademe var.
Derece ve kademe mantığına uygun şekilde yükseltiliyor.

Güncel Kod:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim giris As String
    Dim derece As Integer, kademe As Integer
    Dim sonuc As String

    ' Yalnızca A sütununda işlem yapılmasını sağla
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        ' Birden fazla hücre değiştirilmişse işlem yapma
        If Target.Cells.Count > 1 Then Exit Sub

        ' Girilen değeri al
        giris = Target.Value

        ' Derece ve kademe ayırma kontrolü
        On Error Resume Next
        derece = Split(giris, "/")(0)
        kademe = Split(giris, "/")(1)
        On Error GoTo 0

        ' Geçerli format kontrolü
        If IsNumeric(derece) And IsNumeric(kademe) Then
            ' Derece ve kademe sınırları
            If derece >= 1 And derece <= 12 And kademe >= 1 And kademe <= 4 Then
                ' Kademe artırma ve derece düşürme mantığı
                If derece = 1 And kademe = 4 Then
                    MsgBox "1/4 son derece ve kademedir.", vbExclamation
                    Exit Sub
                ElseIf derece > 1 And kademe < 3 Then
                    ' Derece > 1 ise ve kademe < 3 ise sadece kademe artır
                    kademe = kademe + 1
                ElseIf derece > 1 And kademe = 3 Then
                    ' Derece > 1 ve kademe 3 olduğunda, dereceyi bir azalt, kademe 1 yap
                    derece = derece - 1
                    kademe = 1
                ElseIf derece = 1 And kademe < 4 Then
                    ' Derece = 1 olduğunda kademe 4'e kadar artır
                    kademe = kademe + 1
                End If

                ' Yeni derece/kademe oluştur
                sonuc = derece & "/" & kademe

                ' Hücreleri "Metin" olarak biçimlendir
                Application.EnableEvents = False
                Target.NumberFormat = "@"
                Target.Offset(0, 1).NumberFormat = "@"

                ' Sonucu yan hücreye yaz
                Target.Offset(0, 1).Value = sonuc
                Application.EnableEvents = True
            Else
                MsgBox "Geçerli bir derece/kademe girin (örneğin, 10/1).", vbExclamation
            End If
        End If
    End If
End Sub

Kodun Çalışma Mantığı:

Derece ve Kademe Mantığı:
- Derece 1 ise: Kademe 4’e kadar çıkar, sonra durur.
- Derece 2 ile 12 arasında ise: Kademe 3’e kadar çıkar, sonra bir üst dereceye geçer.
Geçersiz Değer Kontrolü:
- Girişin geçerli bir format olup olmadığını kontrol eder (n/n formatında olmalı).
Hücreleri Metin Formatına Çevirme:
- Hem yazılan hücre hem de sonuç hücresini otomatik olarak "Metin" biçimine çevirir.

Kullanım:

A sütununda bir hücreye derece/kademe yazın (örneğin, 10/3).
Enter tuşuna bastığınızda:
- Yanındaki hücrede bir sonraki derece/kademe otomatik olarak hesaplanır.
- Örneğin: 10/3 yazarsanız 9/1 yan hücreye yazılacaktır.

Sonsuz teşekkürler hocam. Formül olarak da paylaşabilir misiniz

tugkan · 18 Kasım 2024

Evet, bu işlemi formüllerle de gerçekleştirebilirsiniz. Ancak formüller, VBA kadar esnek değildir ve metin formatı gibi ek işlemleri otomatik olarak yapamaz. Yine de istenilen derece/kademe ilerlemesini sağlayan bir formül oluşturabiliriz.

Formül:
Aşağıdaki formülü, B sütununda (A1 hücresindeki değere göre) kullanabilirsiniz. Hücreye göre dereceleri ve kademeleri hesaplar.

Kod:

=EĞER(EĞERHATA(BUL("/";A1);0)=0;"";EĞER(BAĞ_DEĞ_DOLU(A1);EĞER(SOLDAN(A1;BUL("/";A1)-1)*1=1;EĞER(PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1<4;SOLDAN(A1;BUL("/";A1)-1)&"/"&PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1+1;"");EĞER(PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1<3;SOLDAN(A1;BUL("/";A1)-1)&"/"&PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1+1;SOLDAN(A1;BUL("/";A1)-1)*1-1&"/1"));"")))

Formül Mantığı:

EĞERHATA: Hataları önler. Eğer hücre boşsa ya da uygun formatta değilse formül boş döner.
SOLDAN ve PARÇAAL:Derece ve kademeyi ayrıştırır:
- Örneğin 10/3 için SOLDAN → 10, PARÇAAL → 3 döner.
Derece ve Kademe Mantığı:
- Derece 1 olduğunda 4. kademeye kadar gider, sonra durur.
- Diğer dereceler için 3 kademeye kadar ilerler, sonra bir sonraki dereceye geçer.
Boş veya hatalı giriş durumları:
- Eğer giriş formatı n/n değilse (örneğin 10/3 gibi) formül boş değer döner.

Kullanım:

A sütununda bir hücreye giriş yapın (örneğin, 10/3).
B sütunundaki hücreye yukarıdaki formülü yapıştırın.
Girdiği değerlere göre yan hücrede sonuç otomatik olarak hesaplanır.

Örnek:

A Sütunu (Girdi)	B Sütunu (Sonuç)
10/3	9/1
2/3	2/4
1/4	(Boş)
12/2	12/3

By.TRabZonLutm · 18 Kasım 2024

tugkan' Alıntı:
Evet, bu işlemi formüllerle de gerçekleştirebilirsiniz. Ancak formüller, VBA kadar esnek değildir ve metin formatı gibi ek işlemleri otomatik olarak yapamaz. Yine de istenilen derece/kademe ilerlemesini sağlayan bir formül oluşturabiliriz.

Formül:
Aşağıdaki formülü, B sütununda (A1 hücresindeki değere göre) kullanabilirsiniz. Hücreye göre dereceleri ve kademeleri hesaplar.

Kod:

=EĞER(EĞERHATA(BUL("/";A1);0)=0;"";EĞER(BAĞ_DEĞ_DOLU(A1);EĞER(SOLDAN(A1;BUL("/";A1)-1)*1=1;EĞER(PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1<4;SOLDAN(A1;BUL("/";A1)-1)&"/"&PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1+1;"");EĞER(PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1<3;SOLDAN(A1;BUL("/";A1)-1)&"/"&PARÇAAL(A1;BUL("/";A1)+1;UZUNLUK(A1))*1+1;SOLDAN(A1;BUL("/";A1)-1)*1-1&"/1"));"")))

Formül Mantığı:

EĞERHATA: Hataları önler. Eğer hücre boşsa ya da uygun formatta değilse formül boş döner.

SOLDAN ve PARÇAAL:Derece ve kademeyi ayrıştırır:

Örneğin 10/3 için SOLDAN → 10, PARÇAAL → 3 döner.

Derece ve Kademe Mantığı:

Derece 1 olduğunda 4. kademeye kadar gider, sonra durur.

Diğer dereceler için 3 kademeye kadar ilerler, sonra bir sonraki dereceye geçer.

Boş veya hatalı giriş durumları:

Eğer giriş formatı n/n değilse (örneğin 10/3 gibi) formül boş değer döner.

Kullanım:

A sütununda bir hücreye giriş yapın (örneğin, 10/3).

B sütunundaki hücreye yukarıdaki formülü yapıştırın.

Girdiği değerlere göre yan hücrede sonuç otomatik olarak hesaplanır.

Örnek:

A Sütunu (Girdi)
B Sütunu (Sonuç)
10/3
9/1
2/3
2/4
1/4
(Boş)
12/2
12/3

A sütununda genel olan bölümü metin olarak değiştirdim. Formülü b sütuna yapıştırdım. Formulle alakalı sorun var dedi. İşlem yaptırmadi hocam

tugkan · 18 Kasım 2024

tugkan' Alıntı:

Her derecede üç kademe var, sadece 1. derecede dört kademe var.
Derece ve kademe mantığına uygun şekilde yükseltiliyor.

Güncel Kod:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim giris As String
    Dim derece As Integer, kademe As Integer
    Dim sonuc As String

    ' Yalnızca A sütununda işlem yapılmasını sağla
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        ' Birden fazla hücre değiştirilmişse işlem yapma
        If Target.Cells.Count > 1 Then Exit Sub

        ' Girilen değeri al
        giris = Target.Value

        ' Derece ve kademe ayırma kontrolü
        On Error Resume Next
        derece = Split(giris, "/")(0)
        kademe = Split(giris, "/")(1)
        On Error GoTo 0

        ' Geçerli format kontrolü
        If IsNumeric(derece) And IsNumeric(kademe) Then
            ' Derece ve kademe sınırları
            If derece >= 1 And derece <= 12 And kademe >= 1 And kademe <= 4 Then
                ' Kademe artırma ve derece düşürme mantığı
                If derece = 1 And kademe = 4 Then
                    MsgBox "1/4 son derece ve kademedir.", vbExclamation
                    Exit Sub
                ElseIf derece > 1 And kademe < 3 Then
                    ' Derece > 1 ise ve kademe < 3 ise sadece kademe artır
                    kademe = kademe + 1
                ElseIf derece > 1 And kademe = 3 Then
                    ' Derece > 1 ve kademe 3 olduğunda, dereceyi bir azalt, kademe 1 yap
                    derece = derece - 1
                    kademe = 1
                ElseIf derece = 1 And kademe < 4 Then
                    ' Derece = 1 olduğunda kademe 4'e kadar artır
                    kademe = kademe + 1
                End If

                ' Yeni derece/kademe oluştur
                sonuc = derece & "/" & kademe

                ' Hücreleri "Metin" olarak biçimlendir
                Application.EnableEvents = False
                Target.NumberFormat = "@"
                Target.Offset(0, 1).NumberFormat = "@"

                ' Sonucu yan hücreye yaz
                Target.Offset(0, 1).Value = sonuc
                Application.EnableEvents = True
            Else
                MsgBox "Geçerli bir derece/kademe girin (örneğin, 10/1).", vbExclamation
            End If
        End If
    End If
End Sub

Kodun Çalışma Mantığı:

Derece ve Kademe Mantığı:
- Derece 1 ise: Kademe 4’e kadar çıkar, sonra durur.
- Derece 2 ile 12 arasında ise: Kademe 3’e kadar çıkar, sonra bir üst dereceye geçer.
Geçersiz Değer Kontrolü:
- Girişin geçerli bir format olup olmadığını kontrol eder (n/n formatında olmalı).
Hücreleri Metin Formatına Çevirme:
- Hem yazılan hücre hem de sonuç hücresini otomatik olarak "Metin" biçimine çevirir.

Kullanım:

A sütununda bir hücreye derece/kademe yazın (örneğin, 10/3).
Enter tuşuna bastığınızda:
- Yanındaki hücrede bir sonraki derece/kademe otomatik olarak hesaplanır.
- Örneğin: 10/3 yazarsanız 9/1 yan hücreye yazılacaktır.

Maalesef formülle çözüm bulamadım. Ama makrolu olan çalışıyor.

By.TRabZonLutm · 18 Kasım 2024

Ilgi alakanıza çok teşekkür ederim. Konu çözüldü

Çözüldü Bir sonraki sayıyı otomatik eklesin

By.TRabZonLutm

Trilenium

Destek Ekibi

tugkan

By.TRabZonLutm

Trilenium

Destek Ekibi

By.TRabZonLutm

By.TRabZonLutm

Trilenium

Destek Ekibi

By.TRabZonLutm

Trilenium

Destek Ekibi

Necdet

Moderatör

Ekli dosyalar

md3m1ray

By.TRabZonLutm

By.TRabZonLutm

tugkan

By.TRabZonLutm

tugkan

By.TRabZonLutm

tugkan

By.TRabZonLutm