[Yardım]  Hücre değeri aynı olanlar renklensin ve diğer sütuna yazsın

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#21)  Halil_61 » 09 Şub 2019 21:40

Hocam erken konuştum sanırım ama bir önceki konumuz olan gruplama hakkında sorunum var. Birden fazla 3 hücrenin aynı olması durumunda bir hücreyi farklı renklendiriyor. Ekte görebilirsiniz hocam, "73659" yenilenen veridir. İki hücre mor biri kahve olarak renk almıştır.Yan sütunda ki veriyi de mor renk olarak atamıştır. Sonuç olarak aynı olan veriler tek renk olması için nasıl yardımcı olabilir siniz Hocam ? Ve mümkünse yenilenen bu fatura numaralarını benzersiz olarak listelediğim "L" sütununda da aynı rengi atayabilir miyiz ? Yani "73659" L sütununda da mor renk olsun hocam istiyorum.

Çok Teşekkür Ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#22)  Halil_61 » 10 Şub 2019 17:56

Hocam sevindim yaptım diye ama mantık hatası var sanırım. Aşağıdaki kodlara ne yapabiliriz acaba ? araya eklediğim kod için açıklama yazdım. Yardımcı olursanız çok memnun olurum.Çok Teşekkürler.

Kod: Tümünü seç
Sub grupla()

Dim yaz As Integer
Dim renk As Integer
Range("J12:J1000000").ClearContents
Range("I12:I" & Rows.Count).Interior.ColorIndex = 0
Range("J12:J" & Rows.Count).Interior.ColorIndex = 0
yaz = 12
renk = 12
For a = 12 To Range("I1000000").End(xlUp).Row
   If Cells(a, "I").Interior.ColorIndex > 0 Then GoTo atla
   For i = a + 1 To Range("I1000000").End(xlUp).Row
   'On Error Resume Next
        If Cells(a, "I").Value2 = Cells(i, "I").Value2 And Cells(i, "I") <> "" Then
        Cells(yaz, "J") = Cells(a, "I")
            Cells(yaz, "J").Interior.ColorIndex = renk
            Cells(a, "I").Interior.ColorIndex = renk
            Cells(i, "I").Interior.ColorIndex = renk
            End If
           
            ' Hocam burada IF değerini sonlandırdım  ve tekrar IF ile aşağıdaki satırı ekledim yapmak istediğim "I" sütununda aynı değer var ise aynı renk değilse farklı renk olması için uğraştım ama istediğim gibi oldu fakat satırlar artınca yani değerler artınca patlıyor sanırım mantık hatası var.
           
If Cells(a, "I").Interior.ColorIndex <> renk Then

renk = renk + 1

End If
   Next i

yaz = yaz + 1
atla:
Next a

    Range("J12:J100000").Select
    'Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    Range("J12").Select
   
End Sub
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#23)  Halil_61 » 17 Şub 2019 13:05

Merhaba Hocalarım,
Bu konuda gerçekten yardıma ihtiyacım var. Değerli Kasnic Hocayla bir yerede getirebildik ancak renklendirme konusunda takıldım.Bende elimden geldiğince çok uğraştım ilgilenebilirseniz çok memnun olacağım.
Çok Teşekkürler.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#24)  Kasnic » 18 Şub 2019 08:32

Halil bey merhaba,
renk = renk +1 kodunu next i den sonraya yazınız. O zaman düzeliyor.
çözemediğim konu, liste uzun olunca(noktalama işaretindeki çalışmadaki L72 den sonraki gibi) renk=renk +1 kodunu eski yerine almak gerekiyor. Çok ilginç. :o
Kullanıcı avatarı
Kasnic
Siteye Alışmış
 
Kayıt: 19 Nis 2018 15:39
Meslek: Satınalma
Yaş: 30
İleti: 179
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#25)  Halil_61 » 18 Şub 2019 16:48

Evet Hocam gerçekten ilginç liste kısayken dediğiniz gibi next i 'den sonra renk = renk +1 yazınca oluyor Fakat listede 500 satır varken patlıyor. Ne denediysem olmadı [ilginc] Hocam zamanınızı alıyorum ama çok sağ olun ilginiz için, başka arkadaşlar baksa belki onların bildiği bir şey vardır diye düşünüyorum. Ben işin içinden çıkamadım.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#26)  askmadige34 » 18 Şub 2019 22:01

renk=renk+1 satırı yerine
If renk = 56 Then
renk = 12
Else
renk = renk + 1
End If
eklerseniz takılmaz sanırım.
Zira 56 renkden fazla renk kodu yok.
askmadige34
Forum Moderatörü
 
Kayıt: 20 Kas 2015 11:04
Meslek: memur
Yaş: 39
İleti: 1720
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kayseri

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Hücre değeri aynı olanlar renklensin ve diğer

İleti#27)  Kasnic » 19 Şub 2019 08:28

askmadige34 yazdı:renk=renk+1 satırı yerine
If renk = 56 Then
renk = 12
Else
renk = renk + 1
End If
eklerseniz takılmaz sanırım.
Zira 56 renkden fazla renk kodu yok.

Hocam bu bilgi çok iyi geldi. şkşk
Kullanıcı avatarı
Kasnic
Siteye Alışmış
 
Kayıt: 19 Nis 2018 15:39
Meslek: Satınalma
Yaş: 30
İleti: 179
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Cevap: Hücre değeri aynı olanlar renklensin ve diğer

İleti#28)  Halil_61 » 19 Şub 2019 23:10

askmadige34 yazdı:renk=renk+1 satırı yerine
If renk = 56 Then
renk = 12
Else
renk = renk + 1
End If
eklerseniz takılmaz sanırım.
Zira 56 renkden fazla renk kodu yok.



Hocam emeğinize sağlık süper noktaladınız şkşk Kasnic Hocam sizede herşey için çok teşekkür ediyorum emeğiniz çok --)(
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#29)  Halil_61 » 20 Şub 2019 22:12

Tekrar Merhaba Hocam,

Hocalarım sayenizde yardımınızla projeyi son haline getirdim. @askmadige34 hocam sizin yardımınızla renk sorununu çözdük fakat sonuçlanması çok uzun sürüyor projenin son halini ekte gönderiyorum ve grupla butonuna basarsanız 2 dk. gibi bir süre sürüyor.İki defa for döngüsü var hocam burayla ilgili olabilir mi ?

Birde hocam aşağıdaki satırı
For a = 12 To Range("I1000000").End(xlUp).Row


Aşağıda ki gibi değiştirdim belki hızlanır diye ama yinede yaptığımı belirtmek istedim.
For a = 12 To Sheet1.Cells(Rows.Count, "I").End(3).Row


Hocam yardımınız için şimdiden çok teşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#30)  Halil_61 » 21 Şub 2019 22:07

Merhaba,
Hocam bakabildiniz mi acaba?
Çok Teşekkürler.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#31)  Halil_61 » 03 Mar 2019 21:59

Merhaba,
Son haline getirdim hocam, sorunu çözdüm. Fakat ufak bir sorunum kaldı yardımcı olabilirseniz çok sevinirim. Grupla dediğimizde J12 Hücresinden başlayarak yazması için aşağıdaki kodu nasıl düzenleyebilirim? Çok Teşekkürler.

Kod: Tümünü seç
Sub grupla()
Dim yaz As Integer
Dim renk As Integer
Range("J12:J2000").ClearContents
Range("I12:I" & Rows.Count).Interior.ColorIndex = 2
Range("J12:J" & Rows.Count).Interior.ColorIndex = 2

yaz = 12
renk = 12
yazi = 12

For a = 12 To Sheet1.Cells(Rows.Count, "I").End(3).Row
   If Cells(a, "I").Interior.ColorIndex > 2 Then GoTo atla
For i = a + 1 To Sheet1.Cells(Rows.Count, "I").End(3).Row
   
If Cells(a, "I").Value2 = Cells(i, "I").Value2 And Cells(i, "I") <> "" Then
            Cells(yaz, "J") = Cells(a, "I")
            Cells(yaz, "J").Interior.ColorIndex = renk
            Cells(yaz, "J").Font.ColorIndex = yazi
            Cells(a, "I").Interior.ColorIndex = renk
            Cells(i, "I").Interior.ColorIndex = renk
            Cells(a, "I").Font.ColorIndex = yazi
            Cells(i, "I").Font.ColorIndex = yazi
End If

    Next i
If renk = 56 Then
renk = 3
Else
renk = renk + 1
    End If

    Select Case renk
    Case Is = 1, 9, 11, 13, 21, 25, 29, 30, 31, 32, 49, 51, 52, 53, 54, 55, 18, 3
        yazi = 2
    Case Else
        yazi = 1
    End Select

yaz = yaz + 1

atla:
Next a
   
End Sub
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#32)  Halil_61 » 04 Mar 2019 23:09

Arkadaşlar ben bunu yapamadım, yardımınızı rica ediyorum.
Çok teşekkürler.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#33)  Halil_61 » 05 Mar 2019 19:48

Merhaba Arkadaşlar,
Kod yapısında sıkıntım var arkadaşlar, yardımcı olabilecek misiniz? Dosyanın son hali ektedir. Çok teşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Cevap: Hücre değeri aynı olanlar renklensin ve diğer sütuna

İleti#34)  Halil_61 » 06 Mar 2019 17:22

sorunu çözdüm.Arkadaşlara yardımcı olmak adına aşağıda kodları paylaşıyorum.Grupla Makrosuna yapıştırınız.

Kod: Tümünü seç
Sub grupla()
Dim yaz As Integer
Dim renk As Integer
Dim Yazi As Integer
Range("J12:J2000").ClearContents
Range("I12:I" & Rows.Count).Interior.ColorIndex = 2
Range("J12:J" & Rows.Count).Interior.ColorIndex = 2

yaz = 12
renk = 12
Yazi = 12

For a = 12 To Sheet1.Cells(Rows.Count, "I").End(3).Row
   If Cells(a, "I").Interior.ColorIndex > 2 Then GoTo atla
For i = a + 1 To Sheet1.Cells(Rows.Count, "I").End(3).Row
   
If Cells(a, "I").Value2 = Cells(i, "I").Value2 And Cells(i, "I") <> "" Then
           
            Cells(yaz, "J") = Cells(a, "I")
            Cells(yaz, "J").Interior.ColorIndex = renk
            Cells(yaz, "J").Font.ColorIndex = Yazi
            Cells(a, "I").Interior.ColorIndex = renk
            Cells(i, "I").Interior.ColorIndex = renk
            Cells(a, "I").Font.ColorIndex = Yazi
            Cells(i, "I").Font.ColorIndex = Yazi
            yaz = yaz + 1
End If
    Next i
If renk = 56 Then
renk = 3
Else
renk = renk + 1
    End If

    Select Case renk
    Case Is = 1, 9, 11, 13, 21, 25, 29, 30, 31, 32, 49, 51, 52, 53, 54, 55, 18, 3
        Yazi = 2
    Case Else
        Yazi = 1
    End Select

atla:
Next a
   
End Sub


Herkese her şey için [TESEKKÜR] .
Kullanıcı avatarı
Halil_61
Siteye Alışmış
 
Adı Soyadı:Halil ASAN
Kayıt: 06 Nis 2013 19:24
Konum: İş
Meslek: Bilgi İşlem Uzmanı
Yaş: 32
İleti: 173
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Kadıköy

Önceki

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Yandex[Bot] ve 1 misafir

Bumerang - Yazarkafe