Koşula göre değer atama

D.Ozsahin

Altın Üye
Katılım
25 Mart 2020
Mesajlar
20
Excel Vers. ve Dili
Profesyonel Plus 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2025
Bunu örnek excel dosyası şeklinde paylaşır mısınız?
Çalıştığım dosyayı ek'e koydum. Buna benzer aynı mantıkta çalıştığım birkaç excel daha var ama bunda yaptıklarımı ona da uygulayabilirim.
Dosyayı göndermişken bir önceki mesajdaki sorumu hem genişleteyim hem fikir alayım o zaman sizden.
Şöyle izah edeyim;
Formülde kullanmam gereken ana kaynağım Döküman Numarası sütunundaki 975-501-BB-001 şeklinde yazan numara. Ben bunu yandaki sütunlara açarak yazıyorum ki detaylı filtreleme yapabileyim diye. Tabloda renkli olarak belirttim hangisini nereye yazdığımı. Döküman numarasını sütunlara ayrıştırma işini Metni sütunlara dönüştür ile yapıyorum. Aslında benim işime en çok yarayacak şey numarayı girip (975-501-BB-001) enter dediğimde ilgili sütunlara dağıtması. Böyle bir şeye ihtiyacım var ama çok fazla olmasa da farklı veri girebiliyorum Döküman numarası sütununa. Bu sefer formül nasıl çalışır sıkıntı olur mu ?

İlk isteğimde Proje Kodu yazan kısımdaki kısaltmaların baş harflerine göre Disiplin kısmına yazılacak kelimeyi yapmıştınız.
Şimdi ise Döküman numarası içerisinde yazan kısatmayı (9 nolu satırdaki örnek) Döküman Tipi kısmına aktarmasını istiyordum sizden.
Kısaltmalar şunlardı (PZ,MZ,BZ,CZ,KZ,EH,AZ,TZ,GR,GZ,YZ) Bu kısatmalar varsa Hesap Raporu yazacak, yoksa Çizim yazacak.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Şimdi ise Döküman numarası içerisinde yazan kısatmayı (9 nolu satırdaki örnek) Döküman Tipi kısmına aktarmasını istiyordum sizden.
Kısaltmalar şunlardı (PZ,MZ,BZ,CZ,KZ,EH,AZ,TZ,GR,GZ,YZ) Bu kısatmalar varsa Hesap Raporu yazacak, yoksa Çizim yazacak.
Aşağıdaki formül işinizi görecektir. Yalnız 614. satırda 975-042-EZ-A-001 kodu için hesap raporu diye belirtmişsiniz ancak kodlarınız arasında EZ bulunmuyor:


=EĞER(YADA(PARÇAAL(E8;9;2)="PZ";PARÇAAL(E8;9;2)="MZ";PARÇAAL(E8;9;2)="BZ";PARÇAAL(E8;9;2)="CZ";PARÇAAL(E8;9;2)="KZ";PARÇAAL(E8;9;2)="EH";PARÇAAL(E8;9;2)="AZ";PARÇAAL(E8;9;2)="TZ";PARÇAAL(E8;9;2)="GR";PARÇAAL(E8;9;2)="GZ";PARÇAAL(E8;9;2)="GY");"Hesap Raporu";"Çizim")

Ya da hem bu işlemi hem de kodu sütunlara dağıtma işlemini aşağıdaki makroyla yapabilirsiniz. Kod E8:E1000 aralığına belirtilen düzende veri girdiğinizde hem kod dağıtır hem de koda göre Hesap raporu ya da Çizim olduğunu L sütununa yazar. Kodu kopyaladıktan sonra ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya) yapıştırmanız gerekiyor:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E8:E1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row

If Target = "" Then
    Cells(a, "F").ClearContents
    Cells(a, "G").ClearContents
    Cells(a, "I").ClearContents
    Cells(a, "L").ClearContents
ElseIf Len(Target) = 14 Then
    Cells(a, "F") = Mid(Target, 5, 3)
    Cells(a, "G") = Mid(Target, 9, 2)
    Cells(a, "I") = Right(Target, 3)
    If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
        Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
        Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
        Cells(a, "L") = "Hesap Raporu"
    Else
        Cells(a, "L") = "Çizim"
    End If
End If
    
End Sub
 

D.Ozsahin

Altın Üye
Katılım
25 Mart 2020
Mesajlar
20
Excel Vers. ve Dili
Profesyonel Plus 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2025
Aşağıdaki formül işinizi görecektir. Yalnız 614. satırda 975-042-EZ-A-001 kodu için hesap raporu diye belirtmişsiniz ancak kodlarınız arasında EZ bulunmuyor:


=EĞER(YADA(PARÇAAL(E8;9;2)="PZ";PARÇAAL(E8;9;2)="MZ";PARÇAAL(E8;9;2)="BZ";PARÇAAL(E8;9;2)="CZ";PARÇAAL(E8;9;2)="KZ";PARÇAAL(E8;9;2)="EH";PARÇAAL(E8;9;2)="AZ";PARÇAAL(E8;9;2)="TZ";PARÇAAL(E8;9;2)="GR";PARÇAAL(E8;9;2)="GZ";PARÇAAL(E8;9;2)="GY");"Hesap Raporu";"Çizim")

Ya da hem bu işlemi hem de kodu sütunlara dağıtma işlemini aşağıdaki makroyla yapabilirsiniz. Kod E8:E1000 aralığına belirtilen düzende veri girdiğinizde hem kod dağıtır hem de koda göre Hesap raporu ya da Çizim olduğunu L sütununa yazar. Kodu kopyaladıktan sonra ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya) yapıştırmanız gerekiyor:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E8:E1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row

If Target = "" Then
    Cells(a, "F").ClearContents
    Cells(a, "G").ClearContents
    Cells(a, "I").ClearContents
    Cells(a, "L").ClearContents
ElseIf Len(Target) = 14 Then
    Cells(a, "F") = Mid(Target, 5, 3)
    Cells(a, "G") = Mid(Target, 9, 2)
    Cells(a, "I") = Right(Target, 3)
    If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
        Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
        Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
        Cells(a, "L") = "Hesap Raporu"
    Else
        Cells(a, "L") = "Çizim"
    End If
End If
   
End Sub
Gerçekten ne kadar teşekkür etsem az. Zahmet verdim size ama bana büyük bir zaman kazancı sağladınız çok teşekkür ediyorum.
İşte el ile girdiğim için onu H olarak görmüşüm sanırım yanlış yazmışım Hesap Raporu diye. Dediğiniz doğru EZ diye bir kısaltma yok. Sayenizde hata riskim de minimuma inecek.

Kolay gelsin iyi çalışmalar diliyorum.
 

D.Ozsahin

Altın Üye
Katılım
25 Mart 2020
Mesajlar
20
Excel Vers. ve Dili
Profesyonel Plus 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2025
Aşağıdaki formül işinizi görecektir. Yalnız 614. satırda 975-042-EZ-A-001 kodu için hesap raporu diye belirtmişsiniz ancak kodlarınız arasında EZ bulunmuyor:


=EĞER(YADA(PARÇAAL(E8;9;2)="PZ";PARÇAAL(E8;9;2)="MZ";PARÇAAL(E8;9;2)="BZ";PARÇAAL(E8;9;2)="CZ";PARÇAAL(E8;9;2)="KZ";PARÇAAL(E8;9;2)="EH";PARÇAAL(E8;9;2)="AZ";PARÇAAL(E8;9;2)="TZ";PARÇAAL(E8;9;2)="GR";PARÇAAL(E8;9;2)="GZ";PARÇAAL(E8;9;2)="GY");"Hesap Raporu";"Çizim")

Ya da hem bu işlemi hem de kodu sütunlara dağıtma işlemini aşağıdaki makroyla yapabilirsiniz. Kod E8:E1000 aralığına belirtilen düzende veri girdiğinizde hem kod dağıtır hem de koda göre Hesap raporu ya da Çizim olduğunu L sütununa yazar. Kodu kopyaladıktan sonra ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp Kod görüntüle deyince açılan sayfaya) yapıştırmanız gerekiyor:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E8:E1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row

If Target = "" Then
    Cells(a, "F").ClearContents
    Cells(a, "G").ClearContents
    Cells(a, "I").ClearContents
    Cells(a, "L").ClearContents
ElseIf Len(Target) = 14 Then
    Cells(a, "F") = Mid(Target, 5, 3)
    Cells(a, "G") = Mid(Target, 9, 2)
    Cells(a, "I") = Right(Target, 3)
    If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
        Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
        Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
        Cells(a, "L") = "Hesap Raporu"
    Else
        Cells(a, "L") = "Çizim"
    End If
End If
   
End Sub
Tek sıkıntı şu oldu
İşaretlediğim örnekte A yazmayan Döküman numarasını kopyala yapıştır yaptığımda sütunlara dağıtıyor içeriği. A yazan Döküman numarasında dağıtmıyor. Her ikisini seçip kopyala yapıştır yaptığımda ikisini de dağıtmıyor.
Kodlamada H sütunu için bir görev verilmemiş sanırım ondan kaynaklı.
Orada harf varsa ayır yoksa aktarma gibi bişey yapılabilir mi ?


InkedEkran Alıntısı_LI.jpg
 

D.Ozsahin

Altın Üye
Katılım
25 Mart 2020
Mesajlar
20
Excel Vers. ve Dili
Profesyonel Plus 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2025
Editleyemedim mesajı süre geçmiş. Toplu olarak numara yapıştırdığımda da aktarmıyor hücrelere. Tek tek yapıştırmam gerekiyor :(
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Ben H sütununa dikkat etmemiştim. İlk verdiğim kodları aşağıdakiyle değiştirin:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E8:E1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row

If Target = "" Then
    Cells(a, "F").ClearContents
    Cells(a, "G").ClearContents
    Cells(a, "H").ClearContents
    Cells(a, "I").ClearContents
    Cells(a, "L").ClearContents
ElseIf Len(Target) = 14 Then
    Cells(a, "F") = Mid(Target, 5, 3)
    Cells(a, "G") = Mid(Target, 9, 2)
    Cells(a, "H").ClearContents
    Cells(a, "I") = Right(Target, 3)
    If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
        Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
        Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
        Cells(a, "L") = "Hesap Raporu"
    Else
        Cells(a, "L") = "Çizim"
    End If
ElseIf Len(Target) = 16 Then
    Cells(a, "F") = Mid(Target, 5, 3)
    Cells(a, "G") = Mid(Target, 9, 2)
    Cells(a, "H") = Mid(Target, 12, 1)
    Cells(a, "I") = Right(Target, 3)
    If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
        Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
        Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
        Cells(a, "L") = "Hesap Raporu"
    Else
        Cells(a, "L") = "Çizim"
    End If
End If
    
End Sub
Topluca kopyalama yaptıktan sonra tüm sütuna işlem yaptırmak için ise aşağıdaki kodları bir modüle kopyalayın ve istediğiniz zaman çalıştırın. E8'den itibaren aşağı doğru her hücreyi kontrol edip hücrelere dağıtır:

PHP:
Sub kodlama()
son = Cells(Rows.Count, "E").End(3).Row

For a = 7 To son
    If Cells(a, "E") = "" Then
        Cells(a, "F").ClearContents
        Cells(a, "G").ClearContents
        Cells(a, "H").ClearContents
        Cells(a, "I").ClearContents
        Cells(a, "L").ClearContents
    ElseIf Len(Cells(a, "E")) = 14 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H").ClearContents
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    ElseIf Len(Cells(a, "E")) = 16 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H") = Mid(Cells(a, "E"), 12, 1)
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    End If
    
End Sub
 

D.Ozsahin

Altın Üye
Katılım
25 Mart 2020
Mesajlar
20
Excel Vers. ve Dili
Profesyonel Plus 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2025
Ben H sütununa dikkat etmemiştim. İlk verdiğim kodları aşağıdakiyle değiştirin:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E8:E1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
a = Target.Row

If Target = "" Then
    Cells(a, "F").ClearContents
    Cells(a, "G").ClearContents
    Cells(a, "H").ClearContents
    Cells(a, "I").ClearContents
    Cells(a, "L").ClearContents
ElseIf Len(Target) = 14 Then
    Cells(a, "F") = Mid(Target, 5, 3)
    Cells(a, "G") = Mid(Target, 9, 2)
    Cells(a, "H").ClearContents
    Cells(a, "I") = Right(Target, 3)
    If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
        Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
        Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
        Cells(a, "L") = "Hesap Raporu"
    Else
        Cells(a, "L") = "Çizim"
    End If
ElseIf Len(Target) = 16 Then
    Cells(a, "F") = Mid(Target, 5, 3)
    Cells(a, "G") = Mid(Target, 9, 2)
    Cells(a, "H") = Mid(Target, 12, 1)
    Cells(a, "I") = Right(Target, 3)
    If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
        Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
        Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
        Cells(a, "L") = "Hesap Raporu"
    Else
        Cells(a, "L") = "Çizim"
    End If
End If
   
End Sub
Topluca kopyalama yaptıktan sonra tüm sütuna işlem yaptırmak için ise aşağıdaki kodları bir modüle kopyalayın ve istediğiniz zaman çalıştırın. E8'den itibaren aşağı doğru her hücreyi kontrol edip hücrelere dağıtır:

PHP:
Sub kodlama()
son = Cells(Rows.Count, "E").End(3).Row

For a = 7 To son
    If Cells(a, "E") = "" Then
        Cells(a, "F").ClearContents
        Cells(a, "G").ClearContents
        Cells(a, "H").ClearContents
        Cells(a, "I").ClearContents
        Cells(a, "L").ClearContents
    ElseIf Len(Cells(a, "E")) = 14 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H").ClearContents
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    ElseIf Len(Cells(a, "E")) = 16 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H") = Mid(Cells(a, "E"), 12, 1)
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    End If
   
End Sub
Sütunlara dağıtma işlemi her iki şekilde de oluyor teşekkürler. Toplu kopyalama için modülü çalıştırdığımda Compile Error hatası veriyor. Sayfa sonundaki End Sub komutunu seçili hale getiriyor mavi ile.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kodlama makrosu şöyle olmalı:

PHP:
Sub kodlama()
son = Cells(Rows.Count, "E").End(3).Row

For a = 8 To son
    If Cells(a, "E") = "" Then
        Cells(a, "F").ClearContents
        Cells(a, "G").ClearContents
        Cells(a, "H").ClearContents
        Cells(a, "I").ClearContents
        Cells(a, "L").ClearContents
    ElseIf Len(Cells(a, "E")) = 14 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H").ClearContents
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    ElseIf Len(Cells(a, "E")) = 16 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H") = Mid(Cells(a, "E"), 12, 1)
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    End If
Next
End Sub
 

D.Ozsahin

Altın Üye
Katılım
25 Mart 2020
Mesajlar
20
Excel Vers. ve Dili
Profesyonel Plus 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2025
Kodlama makrosu şöyle olmalı:

PHP:
Sub kodlama()
son = Cells(Rows.Count, "E").End(3).Row

For a = 8 To son
    If Cells(a, "E") = "" Then
        Cells(a, "F").ClearContents
        Cells(a, "G").ClearContents
        Cells(a, "H").ClearContents
        Cells(a, "I").ClearContents
        Cells(a, "L").ClearContents
    ElseIf Len(Cells(a, "E")) = 14 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H").ClearContents
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    ElseIf Len(Cells(a, "E")) = 16 Then
        Cells(a, "F") = Mid(Cells(a, "E"), 5, 3)
        Cells(a, "G") = Mid(Cells(a, "E"), 9, 2)
        Cells(a, "H") = Mid(Cells(a, "E"), 12, 1)
        Cells(a, "I") = Right(Cells(a, "E"), 3)
        If Cells(a, "G") = "PZ" Or Cells(a, "G") = "MZ" Or Cells(a, "G") = "BZ" Or Cells(a, "G") = "CZ" Or _
            Cells(a, "G") = "KZ" Or Cells(a, "G") = "EH" Or Cells(a, "G") = "AZ" Or Cells(a, "G") = "TZ" Or _
            Cells(a, "G") = "GR" Or Cells(a, "G") = "GZ" Or Cells(a, "G") = "YZ" Then
            Cells(a, "L") = "Hesap Raporu"
        Else
            Cells(a, "L") = "Çizim"
        End If
    End If
Next
End Sub
"Ne yazık ki bu işlemi birleştirilmiş bir hücrede yapamıyoruz" hatası veriyor
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kodu sonradan düzelttim. Bir önceki mesajımdaki kodu deneyin. Önceki mesajımda işlem 7. satırdan başlatılıyordu, halbuki verileriniz 8. satırdan başlıyor.
 

D.Ozsahin

Altın Üye
Katılım
25 Mart 2020
Mesajlar
20
Excel Vers. ve Dili
Profesyonel Plus 2016 - Türkçe
Altın Üyelik Bitiş Tarihi
26-03-2025
Kodu sonradan düzelttim. Bir önceki mesajımdaki kodu deneyin. Önceki mesajımda işlem 7. satırdan başlatılıyordu, halbuki verileriniz 8. satırdan başlıyor.
Tamamdır şimdi oldu. Çok teşekkür ediyorum
 
Üst