Bu yazımızda, arama kelimelerine benzer değeri içeren hücreyi vurgulamak için Range nesnesinin find yöntemini kullanacağız.
Bu örnek için ham veriler şirket adı, çalışan kimliği ve çalışan adından oluşur. Elimizde farklı şirketlerden ham veriler var.
Bu örnekte, I8 hücresinde belirli tanımlanmış şirket adıyla eşleşen hücreyi bulmak ve vurgulamak istiyoruz.
Belirli şirket adlarına sahip hücreleri vurgulamak için I8 hücresine şirket adını girin ve “Gönder” düğmesine tıklayın. “Submit” butonuna “HighlightMatchingResult” makrosu atanmıştır.
“HighlightMatchingResult” makrosu, eşleşen şirket adını içeren hücreyi Sarı renkle vurgulayacaktır.
Mantıksal açıklama
Bu örnekte, özel bir "FindRange" işlevi ve bir "HighlightMatchingResult" makrosu oluşturduk.
"FindRange" özel işlevi, aranan şirket adına benzer değer içeren tüm hücrelerle bir aralık oluşturacaktır.
"HighlightMatchingResult" makrosu özel işlevi çağıracak ve özel işlevin döndürdüğü aralığı Sarı renkte vurgulayacaktır.
Kod açıklaması
SearchRange.Find(Ne:=FindItem)
Yukarıdaki kod, FindItem'e benzer bir değer içeren hücreyi bulmak için kullanılır.
Birleşim(FindRange, MatchingRange)
Yukarıdaki kod, iki aralığı tek bir aralıkta birleştirmek için kullanılır.
SearchRange.FindNext(EşleşenAralık)
Yukarıdaki kod, FindItem'e benzer bir değer içeren sonraki hücreyi bulmak için kullanılır.
Lütfen kod için aşağıdan takip edin
Seçenek Açık İşlev FindRange(FindItem As Variant, SearchRange As Range) As Range 'Değişkenleri bildirme Dim MatchingRange As Range Dim FirstAddress As String with SearchRange ' Değeri FindItem Set MatchingRange = .Find(What:=FindItem) ile eşleşen aralığı bulma 'Kontrol etme herhangi bir eşleşmenin olup olmadığı MatchingRange Hiçbir Şey Değilse, FindRange = MatchingRange ' İlk eşleşen aralığın adresini alma FirstAddress = MatchingRange.Address Do 'Değeri FindItem ile eşleşen tüm aralıkların birleşimi FindRange = Union(FindRange, MatchingRange) 'Finding değeri FindItem ile eşleşen bir sonraki aralık Set MatchingRange = .FindNext(MatchingRange) Loop While MatchingRange.Address FirstAddress End If End With End Function Sub HighlightMatchingResult() 'Değişkenleri bildirme Dim MappingRange As Range Dim UserInput As String 'Kullanıcı tarafından değer girişi alınıyor hücre I8 UserInput = Range("I8").Value 'FindRange özel işlevini çağırıyor Set MappingRange = FindRange(UserInput, ActiveSheet.C olumns("A")) 'Eşlenen aralığı Sarı renk MappingRange.Interior.Color ile vurgulama = RGB(255, 255, 0) End Sub
Bu blogu beğendiyseniz, Facebook'ta arkadaşlarınızla paylaşın. Ayrıca bizi Twitter ve Facebook'ta da takip edebilirsiniz.
Sizden haber almayı çok isteriz, işimizi nasıl geliştirebileceğimizi ve sizin için nasıl daha iyi hale getirebileceğimizi bize bildirin. E-posta sitesinde bize yazın