Belli Hücrelerdeki Metinlere Göre Kontrol

[BedriA]

Arkadaşlar,

Ekteki dosyada hücrelerin içinde

1 . B C D E
2 A . C D E

şeklinde metinler göreceksiniz.

Kod ile şunu yapmak istiyorum:
Eğer A1 hücresinde "1 . B C D E" şeklinde bir metin var ise, orada A nın olmadığını görsün ve hemen yanındaki hücreye "A" yazdırsın. Eğer B olmasaydı, B nin yerinde nokta olsaydı, B yazdıracaktı.

Birden fazla nokta var ise de boş yazdıracak.

Böyle bir kod yazmak mümkün mü?

 

[Merhum İdris SERDAR]

.

Formülle:

=LOOKUP(FIND("•";A1);{6;11;16;21;26};{"A";"B";"C";"D";"E"})

=ARA(BUL("•";A1);{6;11;16;21;26};{"A";"B";"C";"D";"E"})

.

 

[çıtır]

Alternatif,boş yazmak için

=EĞER(TOPLA.ÇARPIM((UZUNLUK(A1)-UZUNLUK(YERİNEKOY(KÜÇÜKHARF(A1);KÜÇÜKHARF("." );"")))/MAK(1;UZUNLUK(".")))>1;"boş";ARA(BUL(".";A1);{1;2;3;4;5};{"A";"B";"C";"D";"E"}))

 

[Ömer BARAN]

Merhaba.

Konuyu Makro(VBA) bölümünde açmışsınız.
Aşağıdaki gibi olabilir.
.

[B]Sub CEVAP_BUL()[/B]
Set wf = Application.WorksheetFunction
[COLOR="Red"]dizi1[/COLOR] = Array(6, 11, 16, 21, 26)
[COLOR="Blue"]dizi2[/COLOR] = Array("A", "B", "C", "D", "E")
For sat = 1 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, 1) <> "" Then
        Cells(sat, 2) = wf.Lookup(wf.Search([B]Chr(149)[/B], Cells(sat, 1), 1), [COLOR="Red"]dizi1[/COLOR] , [COLOR="Blue"]dizi2[/COLOR])
    End If
Next
[B]End Sub[/B]

 

[YUSUF44]

Alternatif:

=EĞER(EĞERSAY(B1:F1;".")<>1;"Boş";İNDİS({"A";"B";"C";"D";"E"};KAÇINCI(".";B1:F1;0)))

 

[BedriA]

Merhaba.

Konuyu Makro(VBA) bölümünde açmışsınız.
Aşağıdaki gibi olabilir.
.

[B]Sub CEVAP_BUL()[/B]
Set wf = Application.WorksheetFunction
[COLOR="Red"]dizi1[/COLOR] = Array(6, 11, 16, 21, 26)
[COLOR="Blue"]dizi2[/COLOR] = Array("A", "B", "C", "D", "E")
For sat = 1 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, 1) <> "" Then
       [COLOR="Red"] Cells(sat, 2) = wf.Lookup(wf.Search([B]Chr(149)[/B], Cells(sat, 1), 1),[/COLOR] [COLOR="Red"]dizi1[/COLOR] , [COLOR="Blue"]dizi2[/COLOR])
    End If
Next
[B]End Sub[/B]

Teşekkür ederim Ömer Hocam.

Makro(VBA) bölümünde açtım çünkü bana kod gerekiyor.
Zaten siz de kod yazmışsınız.

Bu arada kırmızı kısımda "Search özelliği alınamıyor" hatası alıyorum.

Eğer şu ekli dosyayı incelediyseniz, istediğim kodun şöyle izah edeyim:
Öncelikle b1, c1, d1, e1, f1 hücrelerine bakacak bu hücrelerde sırasıyla a, b, c, d, e yazıyorsa g hücresine boş yazacak. Herhangi ikisi, üçü, dördü veya beşi yerine farklı şeyler yazıyorsa, mesela beşinde de nokta varsa, o zaman geçersiz yazacak. Yani öğrenci tüm şıkları işaretlemişse.

a, b, c, d, e nin herhangi dördünde içindeki harfler yazıyor, beşincisinde herhangi farklı bir şey yazıyorsa, mesela nokta gibi, o zaman g hücresine olmayan harfi yazacak.

 

[YUSUF44]

Teşekkür ederim Ömer Hocam.

Makro(VBA) bölümünde açtım çünkü bana kod gerekiyor.
Zaten siz de kod yazmışsınız.

Bu arada kırmızı kısımda "Search özelliği alınamıyor" hatası alıyorum.

Eğer şu ekli dosyayı incelediyseniz, istediğim kodun şöyle izah edeyim:
Öncelikle b1, c1, d1, e1, f1 hücrelerine bakacak bu hücrelerde sırasıyla a, b, c, d, e yazıyorsa g hücresine boş yazacak. Herhangi ikisi, üçü, dördü veya beşi yerine farklı şeyler yazıyorsa, mesela beşinde de nokta varsa, o zaman geçersiz yazacak. Yani öğrenci tüm şıkları işaretlemişse.

a, b, c, d, e nin herhangi dördünde içindeki harfler yazıyor, beşincisinde herhangi farklı bir şey yazıyorsa, mesela nokta gibi, o zaman g hücresine olmayan harfi yazacak.

Farkında mısınız bilmiyorum ama sorunuzun ilk mesajdaki haliyle son mesajdaki hali arasında çok fark var.

 

[BedriA]

Farkında mısınız bilmiyorum ama sorunuzun ilk mesajdaki haliyle son mesajdaki hali arasında çok fark var.

Evet farkındayım. Bu yüzden boşa yorduysam özür dilerim ama elimde olmayan bir nedenle üzerine işlem yaptığım veriler değişti. Hepsi aynı hücredeyken hücre sayısı arttı.

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub test()
Set wf = Application.WorksheetFunction
For i = 1 To Cells(Rows.Count, "A").End(3).Row
    If UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "Boş"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) <> "E" Then
                            Cells(i, "G") = "E"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) <> "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "D"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) <> "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "C"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) <> "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "B"
    ElseIf UCase(Cells(i, "B")) <> "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "A"
    Else
                            Cells(i, "G") = "Geçersiz"
    End If
Next
End Sub

 

[BedriA]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub test()
Set wf = Application.WorksheetFunction
For i = 1 To Cells(Rows.Count, "A").End(3).Row
    If UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "Boş"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) <> "E" Then
                            Cells(i, "G") = "E"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) <> "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "D"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) <> "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "C"
    ElseIf UCase(Cells(i, "B")) = "A" And UCase(Cells(i, "C")) <> "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "B"
    ElseIf UCase(Cells(i, "B")) <> "A" And UCase(Cells(i, "C")) = "B" And UCase(Cells(i, "D")) = "C" And _
                            UCase(Cells(i, "E")) = "D" And UCase(Cells(i, "F")) = "E" Then
                            Cells(i, "G") = "A"
    Else
                            Cells(i, "G") = "Geçersiz"
    End If
Next
End Sub

Yusuf Hocam,

Nokta atışı ile istediğime cevap verdiniz.
Çok ama çok teşekkür ederim.

Selam ve saygılarımla.

 

[YUSUF44]

Set wf ile başlayan satır gereksiz bu arada, önce başka bir çözüm düşündüğümden o satırı yazmıştım, sonra çözümü değiştirdim ama o satır kalmış. Çalışmasına engel değil, sadece kalabalık yapıyor.

 

[BedriA]

Set wf ile başlayan satır gereksiz bu arada, önce başka bir çözüm düşündüğümden o satırı yazmıştım, sonra çözümü değiştirdim ama o satır kalmış. Çalışmasına engel değil, sadece kalabalık yapıyor.

Teşekkür ederim.