Hücre İçindeki İçerdiği Metne Göre Değer Atama - Makro

M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
Herkese merhaba,

Forumda yeni üyeyim belki daha öncesinde benzer bir konu açılmıştır. Yönlendirebilirsiniz.

Sorum şu; A1 hücresinde belirli bir metni içeren değer var ise B2 hücresine istediğim değer yazsın.

Örnek verecek olursam; A1 hücresinde "aaaa" yazıyorsa B2 hücresine "aaa bölümü" yazsın. Bunu "MBUL" fonksiyonu ile yapabiliyorum ancak koşul sayısı 64'ten fazla. :) O nedenle kısa bir örnek ile VBA kodu paylaşırsanız çok sevinirim. Bu işlemi makro ile daha iyi çözeceğim sanıyorum.
 
muygun

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,108
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
Sayfanın kod bölümüne;

Sub işlem()
Cells(2, "b") = ""
If Cells(1, "a") = "aaaa" Then Cells(2, "b") = "aaa bölümü"
End Sub

kodlarını yerleştirip bir butona bağlayarak deneyin.
İyi çalışmalar
 
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
Merhabalar,

Yanıtınız için teşekkür ediyorum. Ancak metin içerisinde içeriyorsa bunu yazdırmak istiyorum. Mesela A sütununda aşağıya doğru 15.000 adet verim var ve bunlar şu şekilde

GRAGX0001
GRAGY0023
GRAGZ0022 ve eğer içinde "GRAG" geçiyorsa "Genel Cerrahi" yazmalı.

GRAKX0001
GRAKY0002
GRAKZ0003 içinde "GRAK" geçiyorsa "KVC" yazmalı gibi.

Dosya yüklemem gerekiyorsa lütfen bildirin.
 
muygun

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,108
Excel Vers. ve Dili
Excel-2003 Türkçe
Örnek dosya ekleyin.

Dosya.tc - Ücretsiz, Hızlı ve Kolay Dosya Paylaşımı - Dosya Upload

Dosya.tc, dosya yükleme ve paylaşım platformudur. Her türlü veriyi (dosya, resim, müzik, video vb.) saklayabilir ve paylaşabilirsiniz. Tamamen ücretsiz, üyeliğe gerek yok. Hiçbir limit yok. Dosya Upload. Dosya Paylaş. Dosya Yükle
s2.dosya.tc s2.dosya.tc

adresine örnek dosyanızı yükleyerek indirme linkini burada paylaşabilirsiniz.
 
E

excelokyanus500

Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Bu işinizi görebilir. Deneyin

Kod: 
Sub BulListele()
    
    Dim rng As Range
    
    For Each rng In Range("A2:A25")
    
        Select Case True
            
        Case rng.Value Like "*GRAG*"
            result = "Genel Cerrahi"
        
        Case rng.Value Like "*GRAKZ*"
          result = "KVC"

        Case Else
            result = "YOK"
            
        End Select
    rng.Offset(0, 1).Value = result
    Next
    
End Sub
 
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
muygun' Alıntı:
Örnek dosya ekleyin.

Dosya.tc - Ücretsiz, Hızlı ve Kolay Dosya Paylaşımı - Dosya Upload

Dosya.tc, dosya yükleme ve paylaşım platformudur. Her türlü veriyi (dosya, resim, müzik, video vb.) saklayabilir ve paylaşabilirsiniz. Tamamen ücretsiz, üyeliğe gerek yok. Hiçbir limit yok. Dosya Upload. Dosya Paylaş. Dosya Yükle
s2.dosya.tc s2.dosya.tc

adresine örnek dosyanızı yükleyerek indirme linkini burada paylaşabilirsiniz.
Genişletmek için tıkla ...

Merhabalar,

Örnek çalışma dosya bağlantısı aşağıdadır.

https://s2.dosya.tc/server24/2vehsk/Ornek_Calisma.xlsx.html

2-3 adet örnek halinde açıklayabilirseniz yeterli olacaktır.

Örnek:

GRAGE içeriyorsa --> Ameliyat
GRACO içeriyorsa --> Ameliyat
CT.RAR içeriyorsa --> Radyoloji gibi.

Teşekkürler.
 
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
excelokyanus500' Alıntı:
Bu işinizi görebilir. Deneyin

Kod: 
Sub BulListele()
   
    Dim rng As Range
   
    For Each rng In Range("A2:A25")
   
        Select Case True
           
        Case rng.Value Like "*GRAG*"
            result = "Genel Cerrahi"
       
        Case rng.Value Like "*GRAKZ*"
          result = "KVC"

        Case Else
            result = "YOK"
           
        End Select
    rng.Offset(0, 1).Value = result
    Next
   
End Sub
Genişletmek için tıkla ...
Hocam desteğinize teşekkür ederim. Bu işimi görecek gibi duruyor. Sadece ikinci satırdan B''den başlatmayı beceremedim. :)
 
E

excelokyanus500

Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Verileriniz A sütununda . Bunlara bakarak A2'den itibaren kontrol yapılıp bir satır kaydırılıp karşılığı yazılıyor.
Dolayısıyla B sütunu için bir şey yapmanıza gerek yok. Kod yenilendi. Sizin düzeltmeniz gereken yerler olabilir. Karşılığı yok olanlar var.
Kendinize göre düzenlersiniz..

Kod: 
Sub BulListele()
    
    Dim rng As Range

 
    
    For Each rng In Range("A2:A111231")
    
        Select Case True
            
Case rng.Value Like "*GRAG*"
            result = "Genel Cerrahi"
        
Case rng.Value Like "*GRAKZ*"
          result = "KVC"
Case rng.Value Like "*GRAGE*"
         result = "Ameliyat"
Case rng.Value Like "*GRBDM*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GNOYA*"
         result = "ODA-YATAK"
Case rng.Value Like "*GRBPS*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBRO*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBON*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBGN*"
         result = "LABORATUVAR"
Case rng.Value Like "*GNMMO*"
         result = "MUAYENE"
Case rng.Value Like "*GRBKR*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRAGS*"
         result = "Ameliyat"
Case rng.Value Like "*GRBDK*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRABY*"
         result = "Ameliyat"
Case rng.Value Like "*GNGEN*"
         result = "GENEL HİZMETLER"
Case rng.Value Like "*GRAPL*"
         result = "Ameliyat"
Case rng.Value Like "*GRAKR*"
         result = "Ameliyat"
Case rng.Value Like "*MR.RAD*"
         result = "RADYOLOJİ"
Case rng.Value Like "*INLP1*"
         result = "PATOLOJİ"
Case rng.Value Like "*GNCPO*"
         result = "Check-Up"
Case rng.Value Like "*GNMMU*"
         result = "MUAYENE"
Case rng.Value Like "*GRAGO*"
         result = "Ameliyat"
Case rng.Value Like "*GRBAA*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*NM.SİN*"
         result = "RADYOLOJİ"
Case rng.Value Like "*GRBKB*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*INLP2*"
         result = "PATOLOJİ"
Case rng.Value Like "*GNCUP*"
         result = "Check-Up"
Case rng.Value Like "*GRBGS*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRAUR*"
         result = "Ameliyat"
Case rng.Value Like "*GRBBY*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBGE*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBRE*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRABC*"
         result = "Ameliyat"
Case rng.Value Like "*GRBUR*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GNOTE*"
         result = "OTELCİLİK HİZMETLERİ"
Case rng.Value Like "*INLPO*"
         result = "PATOLOJİ"
Case rng.Value Like "*GRBGH*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBEN*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*MG.RAD*"
         result = "RADYOLOJİ"
Case rng.Value Like "*GNMCU*"
         result = "MUAYENE"
Case rng.Value Like "*INLAT*"
         result = "LABORATUVAR"
Case rng.Value Like "*GRBSC*"
         result = "BRANŞSPESİFİK"
 

Case Else
            result = "YOK"
            
End Select
           rng.Offset(0, 1).Value = result ' Bir satır kaydır sonucu yaz.
Next
    
End Sub
 
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
excelokyanus500' Alıntı:
Verileriniz A sütununda . Bunlara bakarak A2'den itibaren kontrol yapılıp bir satır kaydırılıp karşılığı yazılıyor.
Dolayısıyla B sütunu için bir şey yapmanıza gerek yok. Kod yenilendi. Sizin düzeltmeniz gereken yerler olabilir. Karşılığı yok olanlar var.
Kendinize göre düzenlersiniz..

Kod: 
Sub BulListele()
   
    Dim rng As Range


   
    For Each rng In Range("A2:A111231")
   
        Select Case True
           
Case rng.Value Like "*GRAG*"
            result = "Genel Cerrahi"
       
Case rng.Value Like "*GRAKZ*"
          result = "KVC"
Case rng.Value Like "*GRAGE*"
         result = "Ameliyat"
Case rng.Value Like "*GRBDM*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GNOYA*"
         result = "ODA-YATAK"
Case rng.Value Like "*GRBPS*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBRO*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBON*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBGN*"
         result = "LABORATUVAR"
Case rng.Value Like "*GNMMO*"
         result = "MUAYENE"
Case rng.Value Like "*GRBKR*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRAGS*"
         result = "Ameliyat"
Case rng.Value Like "*GRBDK*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRABY*"
         result = "Ameliyat"
Case rng.Value Like "*GNGEN*"
         result = "GENEL HİZMETLER"
Case rng.Value Like "*GRAPL*"
         result = "Ameliyat"
Case rng.Value Like "*GRAKR*"
         result = "Ameliyat"
Case rng.Value Like "*MR.RAD*"
         result = "RADYOLOJİ"
Case rng.Value Like "*INLP1*"
         result = "PATOLOJİ"
Case rng.Value Like "*GNCPO*"
         result = "Check-Up"
Case rng.Value Like "*GNMMU*"
         result = "MUAYENE"
Case rng.Value Like "*GRAGO*"
         result = "Ameliyat"
Case rng.Value Like "*GRBAA*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*NM.SİN*"
         result = "RADYOLOJİ"
Case rng.Value Like "*GRBKB*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*INLP2*"
         result = "PATOLOJİ"
Case rng.Value Like "*GNCUP*"
         result = "Check-Up"
Case rng.Value Like "*GRBGS*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRAUR*"
         result = "Ameliyat"
Case rng.Value Like "*GRBBY*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBGE*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBRE*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRABC*"
         result = "Ameliyat"
Case rng.Value Like "*GRBUR*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GNOTE*"
         result = "OTELCİLİK HİZMETLERİ"
Case rng.Value Like "*INLPO*"
         result = "PATOLOJİ"
Case rng.Value Like "*GRBGH*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBEN*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*MG.RAD*"
         result = "RADYOLOJİ"
Case rng.Value Like "*GNMCU*"
         result = "MUAYENE"
Case rng.Value Like "*INLAT*"
         result = "LABORATUVAR"
Case rng.Value Like "*GRBSC*"
         result = "BRANŞSPESİFİK"


Case Else
            result = "YOK"
           
End Select
           rng.Offset(0, 1).Value = result ' Bir satır kaydır sonucu yaz.
Next
   
End Sub
Genişletmek için tıkla ...
Teşekkür ediyorum bu kod işimi görecek. Evet A2'den itibaren seçerek düzelttim.
 
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
excelokyanus500' Alıntı:
Verileriniz A sütununda . Bunlara bakarak A2'den itibaren kontrol yapılıp bir satır kaydırılıp karşılığı yazılıyor.
Dolayısıyla B sütunu için bir şey yapmanıza gerek yok. Kod yenilendi. Sizin düzeltmeniz gereken yerler olabilir. Karşılığı yok olanlar var.
Kendinize göre düzenlersiniz..

Kod: 
Sub BulListele()
   
    Dim rng As Range


   
    For Each rng In Range("A2:A111231")
   
        Select Case True
           
Case rng.Value Like "*GRAG*"
            result = "Genel Cerrahi"
       
Case rng.Value Like "*GRAKZ*"
          result = "KVC"
Case rng.Value Like "*GRAGE*"
         result = "Ameliyat"
Case rng.Value Like "*GRBDM*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GNOYA*"
         result = "ODA-YATAK"
Case rng.Value Like "*GRBPS*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBRO*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBON*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBGN*"
         result = "LABORATUVAR"
Case rng.Value Like "*GNMMO*"
         result = "MUAYENE"
Case rng.Value Like "*GRBKR*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRAGS*"
         result = "Ameliyat"
Case rng.Value Like "*GRBDK*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRABY*"
         result = "Ameliyat"
Case rng.Value Like "*GNGEN*"
         result = "GENEL HİZMETLER"
Case rng.Value Like "*GRAPL*"
         result = "Ameliyat"
Case rng.Value Like "*GRAKR*"
         result = "Ameliyat"
Case rng.Value Like "*MR.RAD*"
         result = "RADYOLOJİ"
Case rng.Value Like "*INLP1*"
         result = "PATOLOJİ"
Case rng.Value Like "*GNCPO*"
         result = "Check-Up"
Case rng.Value Like "*GNMMU*"
         result = "MUAYENE"
Case rng.Value Like "*GRAGO*"
         result = "Ameliyat"
Case rng.Value Like "*GRBAA*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*NM.SİN*"
         result = "RADYOLOJİ"
Case rng.Value Like "*GRBKB*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*INLP2*"
         result = "PATOLOJİ"
Case rng.Value Like "*GNCUP*"
         result = "Check-Up"
Case rng.Value Like "*GRBGS*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRAUR*"
         result = "Ameliyat"
Case rng.Value Like "*GRBBY*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBGE*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBRE*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRABC*"
         result = "Ameliyat"
Case rng.Value Like "*GRBUR*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GNOTE*"
         result = "OTELCİLİK HİZMETLERİ"
Case rng.Value Like "*INLPO*"
         result = "PATOLOJİ"
Case rng.Value Like "*GRBGH*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*GRBEN*"
         result = "BRANŞSPESİFİK"
Case rng.Value Like "*MG.RAD*"
         result = "RADYOLOJİ"
Case rng.Value Like "*GNMCU*"
         result = "MUAYENE"
Case rng.Value Like "*INLAT*"
         result = "LABORATUVAR"
Case rng.Value Like "*GRBSC*"
         result = "BRANŞSPESİFİK"


Case Else
            result = "YOK"
           
End Select
           rng.Offset(0, 1).Value = result ' Bir satır kaydır sonucu yaz.
Next
   
End Sub
Genişletmek için tıkla ...
Hocam merhabalar,

Sizleri buraya ufak bir ekleme yaparak tekrar rahatsız etmek istiyorum. Mevcut koda bir yada birden fazla koşul daha ekleyerek gruplama yapabilir miyim?

Örneğin yukarı yazmış olduğunuz

Case rng.Value Like "*INLAT*"
result = "LABORATUVAR" sonucunu şöyle ifade etmek istersem; INLAT içeriyor ve Laboratuvar ise C2 hücresine de Biyokimya yaz gibi..

Teşekkürler.
 
E

excelokyanus500

Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Deneyin..
Kod: 
Sub BulListele2()
  
Dim rng As Range
 
For Each rng In Range("A2:A111231")
          
If rng.Value Like "*INLAT*" And rng.Offset(0, 1).Value = "LABORATUVAR" Then
rng.Offset(0, 2).Value = "Biyokimya" ' İki satır kaydır sonucu yaz.
End If
Next
  
End Sub
 
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
excelokyanus500' Alıntı:
Deneyin..
Kod: 
Sub BulListele2()
 
Dim rng As Range

For Each rng In Range("A2:A111231")
         
If rng.Value Like "*INLAT*" And rng.Offset(0, 1).Value = "LABORATUVAR" Then
rng.Offset(0, 2).Value = "Biyokimya" ' İki satır kaydır sonucu yaz.
End If
Next
 
End Sub
Genişletmek için tıkla ...
Hocam destekleriniz için teşekkür ederim. İşimi fazlasıyla gördü. Buna daha fazla koşul yazarak aynı şekilde istediğim değeri döndürebilirim değil mi?
 
E

excelokyanus500

Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Merhaba,

And diğer koşulları aynı anda sıralamak için kullanılır. Mesela

If rng.Value Like "*INLAT*" And rng.Offset(0, 1).Value = "LABORATUVAR" And rng.Offset(0, 2).Value = "Haseki" Then
rng.Offset(0, 3).Value = "Haseki Biyokimya" ' Üç sütun kaydır sonucu yaz.
End If

gibi...
 
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
excelokyanus500' Alıntı:
Merhaba,

And diğer koşulları aynı anda sıralamak için kullanılır. Mesela

If rng.Value Like "*INLAT*" And rng.Offset(0, 1).Value = "LABORATUVAR" And rng.Offset(0, 2).Value = "Haseki" Then
rng.Offset(0, 3).Value = "Haseki Biyokimya" ' Üç sütun kaydır sonucu yaz.
End If

gibi...
Genişletmek için tıkla ...
Hemen deniyorum dediğiniz şekilde.

Edit: Hocam şu anda tam istediğim şekilde alt kırılmalara da ayırarak tüm datayı gruplandırabileceğim. Desteklerinize teşekkür ediyorum.
 
Son düzenleme:
M

MertkanDemir

Katılım
5 Mayıs 2023
Mesajlar
12
Excel Vers. ve Dili
Microsof Excel 365
excelokyanus500' Alıntı:
Merhaba,

And diğer koşulları aynı anda sıralamak için kullanılır. Mesela

If rng.Value Like "*INLAT*" And rng.Offset(0, 1).Value = "LABORATUVAR" And rng.Offset(0, 2).Value = "Haseki" Then
rng.Offset(0, 3).Value = "Haseki Biyokimya" ' Üç sütun kaydır sonucu yaz.
End If

gibi...
Genişletmek için tıkla ...
Hocam merhabalar,

Bazı eklemeler yaptıkça sorunlarla karşılaşıyorum. Mesela ayrı bir IF ile koşul eklemek istersem ne yapmam gerekiyor? Üstteki kod gibi başka bir if koşulu yazmak istediğimde mesela?

Teşekkürler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst