DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Function KimKullanmış(Renk As Range) As String
Dim wks As Worksheet
Dim sKimKullanmis As String
Application.Volatile
If TypeOf Renk Is Range Then
For Each wks In ThisWorkbook.Worksheets
If wks.Range("B8") = Renk Then
sKimKullanmis = sKimKullanmis & ", " & wks.Name
End If
Next
KimKullanmış = Mid(sKimKullanmis, 3, Len(sKimKullanmis))
Else
KimKullanmış = Empty
End If
End Function
İlginiz için teşekkürler. Bunun formülle bi yolu yok mudur acaba?Ekteki örnek dosyayı inceleyiniz.
Kullanıcı Tanımlı bir fonksiyon geliştirilmiştir ...
Fonksiyon'un kullanımını hücrelerde gösterdim ... Kodlama şu şekildedir.
Kod:Function KimKullanmış(Renk As Range) As String Dim wks As Worksheet Dim sKimKullanmis As String Application.Volatile If TypeOf Renk Is Range Then For Each wks In ThisWorkbook.Worksheets If wks.Range("B8") = Renk Then sKimKullanmis = sKimKullanmis & ", " & wks.Name End If Next KimKullanmış = Mid(sKimKullanmis, 3, Len(sKimKullanmis)) Else KimKullanmış = Empty End If End Function
Öneriniz çok güzeldi ama işime yaramadı. Çünkü ben sorunu tam anlatamamışım. Bütün suç benim. Gönderdiğiniz kod yanlızca bir kullanıcı için, bir renk yazıyor. Oysa ben bir kullanıcı farklı renklerde kullanmışsa yada kullanacaksa(yanlızca B8 i değilde sütuna eklenecek diğer renkleride) onlarıda yazdırmak istiyorum. Yani Ali hem kırmızı, hem mavi; Ayşe hem kırmızı ,hem yeşil vb gibi ...kullanırsa KOD NASIL OLUR? Bu soru sizin için basit olabilir ama benim için çok zor ve mühim. Tekrar yardımlarınızı bekliyorum.Ekteki örnek dosyayı inceleyiniz.
Kullanıcı Tanımlı bir fonksiyon geliştirilmiştir ...
Fonksiyon'un kullanımını hücrelerde gösterdim ... Kodlama şu şekildedir.
Kod:Function KimKullanmış(Renk As Range) As String Dim wks As Worksheet Dim sKimKullanmis As String Application.Volatile If TypeOf Renk Is Range Then For Each wks In ThisWorkbook.Worksheets If wks.Range("B8") = Renk Then sKimKullanmis = sKimKullanmis & ", " & wks.Name End If Next KimKullanmış = Mid(sKimKullanmis, 3, Len(sKimKullanmis)) Else KimKullanmış = Empty End If End Function
Function KimKullanmış(Renk As String) As String
Dim wks As Worksheet
Dim sKimKullanmis As String
Dim rngBul As Range
Application.Volatile
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> "RENKLER" Then
If wks.Name <> "Hangi Rengi Kim Kullanmış" Then
Set rngBul = wks.Range("B:B").Find(What:=Renk)
If Not rngBul Is Nothing Then
sKimKullanmis = sKimKullanmis & ", " & wks.Name
End If
End If
End If
Next
If Len(sKimKullanmis) = 0 Then
KimKullanmış = Empty
Else
KimKullanmış = Mid(sKimKullanmis, 3, Len(sKimKullanmis))
End If
Bu kısmı sorun değil... Kodu şu şekilde revize ediniz. Sadece, kırmızı ile belirttiğim parametre, koda ilave edilmiştir.Tekrar Merhaba!
Evet haklısınız son kodu yazınca oldu. Ancak bu defada verdiğiniz kodda birşeyi gözardı etmişsiniz galiba.Oda şu; kullanıcılara renkleri(B8 leri) tek tek yazmak gerekiyor. Oysa B8 lere veri formülle geliyordu. Örneğin; "Ali" çalışma sayfasında: A8 e rengin kodunu yazınca geliyordu. Şimdi A8 e rengin kodunu(örneğin: 1 ) yazıyorum, B8 e renk adı(kırmızı) geliyor. Ancak "Hangi Rengi Kim Kullanmış" sayfasına bakınca B8 e renk yazdığı halde o kişi o rengi kullanmış görünmüyor. Çok oldum biliyorum, ama benim işimi görmesi için bu sorunu düzeltmem lazım. Peki bu sorunu nasıl düzeltebiliriz, kodu yazarsanız sorun tamamen çözülmüş olacak. Ve duacınız olacağım.
Function KimKullanmış(Renk As String) As String
Dim wks As Worksheet
Dim sKimKullanmis As String
Dim rngBul As Range
Application.Volatile
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> "RENKLER" Then
If wks.Name <> "Hangi Rengi Kim Kullanmış" Then
Set rngBul = wks.Range("B:B").Find(What:=Renk, [COLOR=red]LookIn:=xlValues[/COLOR])
If Not rngBul Is Nothing Then
sKimKullanmis = sKimKullanmis & ", " & wks.Name
End If
End If
End If
Next
If Len(sKimKullanmis) = 0 Then
KimKullanmış = Empty
Else
KimKullanmış = Mid(sKimKullanmis, 3, Len(sKimKullanmis))
End If
Set rngBul = Nothing
End Function
Keşke daha önceki yıllarda söyleseydiniz ...Yardımlarınız sayesinde. hiç bir sorunum kalmadı. Minnettarlığımı nasıl ifade edeyim bilemiyorum. Sabaha kadar "sağol", "sağol" yazsam yinede hakkınızı ödeyemem. 12 yıldır bana sorun olan bir işimi sayenizde artık elle değilde. bilgisayarda sizin yardımlarınızla yaptığım basit bir excel programı ile çok çabuk yapabileceğim. Bu Forum bir harika. Emeğinize sağlık. SONSUZ TEŞEKKÜRLER....