Soru Ara, Bul ve İşaretleme Hakkında..

[yesimgurol]

Merhabalar,
Analizlerimin olduğu çalışma listem mevcut, burada 10 ve üzeri test kodlarım bulunmakta. Zamanımı alan kısım ise şöyle ;
mesela ;
1-) Hastanın "test 10" isimli testi işaretli ise "test 8" ve "test 11" testlerinin de işaretlenmesi gerekiyor.
2-) Yine "test 11" isimli testi işaretli ve "test 8" işaretli değil ise "test 8" in de işaretlenmesi gerekiyor.

* Buna benzer bir kaç sıkıntılı durumum bulunmakta , eğer bu vermiş olduğum örneklere sorun bulunabilir ise diğerlerini de ona bakarak halledebilirim sanırım:-(
*Ekte bulunan dosyam üzerinde de açıklamaya çalışmıştım.

 

[muygun]

Merhaba;
Doğru anladıysam Eki deneyin.
İyi çalışmalar.

 

[yesimgurol]

Sayın muygun,
Öncelikle ilginiz için çok teşekkür ederim.Emeğinize sağlık, açıklamış olduğunuz gibi gayet güzel ve yapacağım diğer testler içinde uygulama yaptım. Sorun görünmüyor şimdilik. Dosya üzerinde değindiğiniz TEST 11 içinde deneme yanılma ile çözüm bulmaya çalışıyorum bakalım..
Tekrar çok ama çok teşekkür ediyorum. Emeğinize , ilginize sağlık...

 

[yesimgurol]

Tekrar Merhabalar,
Sayın muygun'un #2 nolu mesajında uygulamış olduğu kodlar uygun şeklide çalışıyor. (#3 nolu mesajımdaki küçük bir sorun vardı o da çözüldü)
Lakin olabilecek senaryoları (#1 nolu mesajımdaki madde 1 de belirttiğim) kodlara göre "AA ve AB" sütunlarına yazdığımızda,
"AA" sütunu altına yazdığım "TEST" isimlerinin hepsinin "A2:R2" de olması durumunda hiç bir sorun olmuyor.
Bazı durumlarda "AA" sütunu altına yazdığım "TEST" isimlerinin bazıları "A2:R2" de olmayabiliyor. Bu durumda olmayan TEST isimlerinin olduğu sütunlara da işaret konulmakta.
Bunun önüne geçilebilir mi acaba :-( Yani "AA" sütunundaki TEST isimleri "A2:R2" de yok ise işlem yapılmamasını istiyorum.
Dosyanın son hali de ekteki gibidir.

Sayın muygun'un konu ile ilgili kodları şu şekildedir.

Sub işlem()
Application.ScreenUpdating = False
On Error Resume Next
For i = 3 To Range("aa5536").End(xlUp).Row
arananasıl = Cells(i, "aa")
bulunanasıl = WorksheetFunction.Match(arananasıl, Range("a2:r2"), 0)


For k = 28 To Cells(i, 256).End(xlToLeft).Column
aranantali = Cells(i, k)
bulunantali = WorksheetFunction.Match(aranantali, Range("a2:r2"), 0)

For z = 3 To Cells(1, "ab")
If Cells(z, bulunanasıl) = "x" Or Cells(z, bulunanasıl) = "X" Then
Cells(z, bulunantali) = "X"
End If
Next z
Next k
Next i

Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[muygun]

Merhaba;
Doğru anladıysam eki test edin.
İyi çalışmalar.

 

[yesimgurol]

Merhabalar Sayın muygun;
Kodları çalıştırmayı denediğimde aşağıdaki şekilde uyarı alıyorum:-(

1 - ) "End if without block if" (kodlar üzerinde belirttim)
Bazan kendi uyarladığım kodlarda fazladan koyduğumda buna benzer uyarı aldığımda "End ıf" siliyordum. Burada da sileyim dedim bu kez de ,

2-) "Next without For" uyarısı veriyor:-( (kodlar üzerinde belirttim)

Sub işlem()
Application.ScreenUpdating = False
On Error Resume Next
For i = 3 To Range("aa5536").End(xlUp).Row
bulunanasıl = 0
arananasıl = Cells(i, "aa")
bulunanasıl = WorksheetFunction.Match(arananasıl, Range("a2:r2"), 0)

If bulunanasıl >= 1 Then
For k = 28 To Cells(i, 256).End(xlToLeft).Column
bulunantali = 0
aranantali = Cells(i, k)
bulunantali = WorksheetFunction.Match(aranantali, Range("a2:r2"), 0)
If bulunantali >= 1 Then

For z = 3 To Cells(1, "ab")
If Cells(z, bulunanasıl) = "x" Or Cells(z, bulunanasıl) = "X" Then
Cells(z, bulunantali) = "X"
End If
End If   (1.uyarıyı bu kısımda veriyor)
Next z
Next k  (2.uyarıyı bu kısımda veriyor)
End If
Next i

Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[Korhan Ayhan]

Merhaba,

Kod yazma tekniği olarak uçak burnu (girinti) tekniği uygulanırsa bu tarz hataların önüne geçmek kolaylaşacaktır.

https://www.excel.web.tr/threads/kod-yazmada-estetik-sanati.65876/

 

[muygun]

Merhaba;

End if in yerini doğru yere koymamışım.

Kodları aşağı şekilde değiştirin.

Sub işlem()
Application.ScreenUpdating = False
On Error Resume Next
For i = 3 To Range("aa5536").End(xlUp).Row
bulunanasıl = 0
arananasıl = Cells(i, "aa")
bulunanasıl = WorksheetFunction.Match(arananasıl, Range("a2:r2"), 0)

If bulunanasıl >= 1 Then
For k = 28 To Cells(i, 256).End(xlToLeft).Column
bulunantali = 0
aranantali = Cells(i, k)
bulunantali = WorksheetFunction.Match(aranantali, Range("a2:r2"), 0)
If bulunantali >= 1 Then

For z = 3 To Cells(1, "ab")
If Cells(z, bulunanasıl) = "x" Or Cells(z, bulunanasıl) = "X" Then
Cells(z, bulunantali) = "X"
End If

Next z
End If
Next k
End If
Next i

Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

İyi çalışmalar.

NOT: Aslında Korhan Bey'in uyarısı doğru.
Ama Alışkanlığım gereği merdiven basamağı gibi kodları pek sevmiyorum.

 

[yesimgurol]

Harikasınız Sayın muygun,
Çok mutlu oldum , tamda istediğim gibi oldu sayenizde..Çok ama çok teşekkür ederim. İlginize,emeğinize sağlık..
Sizlere de iyi çalışmalar, diliyorum.