(88) Excel, İsme resim bağlama işlemi
'=İNDİS(Sayfa2!$C:$C;KAÇINCI($B$6;Sayfa2!$B:$B;0);0) formül sabitleme
' Formüller sekmesi /Ad yöneticisi/ Yeni
' "resim" ismini gir. formülü yapıştır.
'resmi olan bir isim gir
'resimli hücreyi kopyala, Özel yapıştır, bağlı resim
'bağlı resme tıkla formül kısmına "resim" gir enter tuşuna bas
(87) Excel, 'Texbox1 içinde Sayfa2'de "B2:B1000" kelime ara, Sonucu Sayfa1'de B6 dan başlayarak ver.
Me.TextBox1.Font.Size = 18
Application.EnableAutoComplete = False
Dim aramaKriteri As String
Dim aramaMetni As String
Dim kaynakSayfa As Worksheet
Dim kaynakAralik As Range
Dim hucre As Range
Dim sonSatirSonuc As Long
Dim eslesenSayisi As Long
Dim tekHarfModu As Boolean
Dim hedefSayfa As Worksheet
Set hedefSayfa = ThisWorkbook.Sheets("Sayfa1")
Set kaynakSayfa = ThisWorkbook.Sheets("Sayfa2")
Set kaynakAralik = kaynakSayfa.Range("B2:B1000")
sonSatirSonuc = hedefSayfa.Cells(hedefSayfa.Rows.Count, "B").End(xlUp).Row
If sonSatirSonuc < 6 Then sonSatirSonuc = 6 ' En az B6'yı koru
hedefSayfa.Range("B6:B" & sonSatirSonuc).ClearContents
eslesenSayisi = 0
aramaMetni = Trim(Me.TextBox1.Value)
If aramaMetni = "" Then
Exit Sub
End If
tekHarfModu = (Len(aramaMetni) = 1)
aramaKriteri = LCase(aramaMetni)
aramaKriteri = Replace(aramaKriteri, "İ", "i")
aramaKriteri = Replace(aramaKriteri, "I", "ı")
aramaKriteri = Replace(aramaKriteri, "Ş", "ş")
aramaKriteri = Replace(aramaKriteri, "Ç", "ç")
aramaKriteri = Replace(aramaKriteri, "Ğ", "ğ")
aramaKriteri = Replace(aramaKriteri, "Ö", "ö")
aramaKriteri = Replace(aramaKriteri, "Ü", "ü")
For Each hucre In kaynakAralik.Cells
If hucre.Value <> "" Then
Dim kaynakDeger As String
kaynakDeger = CStr(hucre.Value)
kaynakDeger = Replace(kaynakDeger, "İ", "i")
kaynakDeger = Replace(kaynakDeger, "I", "ı")
kaynakDeger = Replace(kaynakDeger, "Ş", "ş")
kaynakDeger = Replace(kaynakDeger, "Ç", "ç")
kaynakDeger = Replace(kaynakDeger, "Ğ", "ğ")
kaynakDeger = Replace(kaynakDeger, "Ö", "ö")
kaynakDeger = Replace(kaynakDeger, "Ü", "ü")
kaynakDeger = LCase(kaynakDeger)
Dim eslesmeVar As Boolean
eslesmeVar = False
If tekHarfModu Then
If Left(kaynakDeger, 1) = aramaKriteri Then
eslesmeVar = True
End If
Else
If Left(kaynakDeger, Len(aramaKriteri)) = aramaKriteri Then
eslesmeVar = True
ElseIf InStr(1, " " & kaynakDeger, " " & aramaKriteri) > 0 Then
eslesmeVar = True
End If
End If
If eslesmeVar Then
eslesenSayisi = eslesenSayisi + 1
hedefSayfa.Range("B" & 5 + eslesenSayisi).Value = hucre.Value
End If
End If
Next hucre
End Sub
(86) Excel, Pratik
'‘----------------------------------------
‘---Çalışma Kitabı’na yapıştır---
‘----------------------------------------
‘=====Sunum modu olarak tasarlanan ayarlar=====
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
Range("A1").Select
‘-----Açılışta yüzde 100 olarak ayarlama-----
ActiveWindow.Zoom = 100
Range("A1").Select
End Sub
‘---------------------------------------------------
‘---Sayfa 1, Çalışma sayfasına yapıştır---
‘--------------------------------------------------
' --Satırları büyük ve kalın yapma--
'--------------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' Tıklanan Satır kalın ve büyük olsun
'
Const ANA_ARALIK As String = "B24:I1000" ' ARALIK GÜNCELLENDİ
Const BUYUK_BOYUT As Long = 11
Const KUCUK_BOYUT As Long = 11
On Error GoTo HataYakala
Application.EnableEvents = False
' A1'e tıklandığında tüm ANA_ARALIK'ı küçük boyuta ve normal (kalınsız) yap.
If Target.Address(False, False) = "A1" Then
With Me.Range(ANA_ARALIK).Font
.Size = KUCUK_BOYUT
.Bold = False ' Tüm aralığı kalın yapma özelliğini kaldır.
End With
GoTo HataYakala
End If
' Ana aralık dışında bir yere tıklandıysa çık.
If Intersect(Target, Me.Range(ANA_ARALIK)) Is Nothing Then GoTo HataYakala
' Tek bir hücre seç.
If Target.Cells.CountLarge > 1 Then Set Target = Target.Cells(1, 1)
' Önce tüm aralığı küçült ve kalınsız yap.
With Me.Range(ANA_ARALIK).Font
.Size = KUCUK_BOYUT
.Bold = False ' Önceki kalın ayarını kaldır.
End With
' Sonra seçili satırı (B sütunundan N sütununa kadar) büyüt VE kalın (Bold = True) yap.
With Me.Range("B" & Target.Row & ":I" & Target.Row).Font ' N SÜTUNU BURADA GÜNCELLENDİ
.Size = BUYUK_BOYUT
.Bold = True ' Tıklanan satırı kalın yap.
End With
HataYakala:
Application.EnableEvents = True
End Sub
‘=====Filtre Kaldır butonu=====
‘-----Filtre kaldır butonuna birden fazla görev yerine getirmesi için alt komutlar da bir arada-----
‘-----Filtre kaldır butonuna basılınca, dilimleme filtrelerini kaldırır-----
Sub FiltreKaldır()
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = ActiveSheet
Set tbl = ws.ListObjects(1)
If tbl.AutoFilter.FilterMode Then
tbl.AutoFilter.ShowAllData
End If
Range("A1").Select
‘-----“CommandButton1” Activex butonu basma işlemi-----
‘-----Aşağıdaki kod ile gerçekleşir.-----
‘-----Bu buton. “Filtre kaldır” butonu altına gizlenir.-----
Call CommandButton1_Click
‘-----Yukarıdaki buton1 çalıştığında silinen renkli hücre sayısının güncel-----
‘-----“0” dönüşmüş değerini almak için, Renkli hücre sayısını bulma kodu-----
‘-----Bu sayfada iki defa kullanılır. Aşağıda, “Filtre kaldıre içine konulan ikincisi-----
'Sub RenkliHucreSayisiBul()
Dim sayfa As Worksheet
Dim hucre As Range
Dim renkKodu As Long
Dim sayac As Long
Set sayfa = ActiveSheet
' Aradığımız rengin RGB kodu
' RGB(144, 238, 144) = Açık yeşil tonu
renkKodu = RGB(144, 238, 144)
' Sayacı sıfırla
sayac = 0
' Sayfa üzerindeki kullanılan tüm hücreleri döngüye al
For Each hucre In sayfa.UsedRange
' Hücrenin dolgu rengi (Interior.Color) aradığımız renkle eşleşiyor mu kontrol et
If hucre.Interior.Color = renkKodu Then
' Eşleşiyorsa sayacı bir artır
sayac = sayac + 1
End If
Next hucre
' Sonucu X5 hücresine yaz
sayfa.Range("X5").Value = sayac
‘ -----Satırları filtre işleminde oluşacak düzensizlikleri gidermek için-----
‘-----Veri Sırala, Hücreleri istediğimiz öncelik sırasına göre A-Z dizip makro kaydı alınır-----
‘-----Ayrı bir makro kaydederek elde edeceğimiz kodu bu alana yapıştırırız-----
' sirala Makro
Range("Tablo2[[#Headers],[Klasör]]").Select
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[Klasör]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[Kamera Adı]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[Model]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[Seri No]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[MAC Adres]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[IP]"), SortOn:=xlSortOnValues, Order:=xlAscending _
, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[Yazılım Sürümü]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[Not 1]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add Key:=Range("Tablo2[Not 2]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
' -----Arama Texbox kelime silme ve Renk Temizle Makrosu----
' -----Arama Texbox kelime temizleme (Buton1, ancak Activex olmalı)-----
‘-----(Aşağıdaki kod butona çift tıklayınca açılacak alana kopyalanmalı)-----
Private Sub CommandButton1_Click()
TextBox1.Value = ""
' -----Arama sonucu, Renk Temizle-----
' Tüm sütunlar ve aşağısı (Shift SağOk ve AşağıOk) seçilerek renk temizliği-----
Range("B24:J24").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'-----SatirYuksekligiAyarla (Shift SağOk ve AşağıOk) seçilerek-----
Rows("24:24").Select
Range(Selection, Selection.End(xlDown)).Select
Rows("24:655").EntireRow.AutoFit
Range("A1").Select
End Sub
' -----“RENK Filtre” Makrosu---- (Yeşil renk)
' RENK Filtre butonuna bağlanacak kod (Buton2, ancak Activex olmalı)
' -----Arama Texbox kelime temizleme-----
‘-----(Aşağıdaki kod butona çift tıklayınca açılacak alana kopyalanmalı)-----
‘----- RENK Filre butonuna bağlanacak kod (Buton1 de olabilir, ancak Activex olmalı)
‘-----Hucreler_Sirala Makro (Bu Alanı ayriyeten makro kaydı yaparak alıp eklemeli.
‘-----Tüm hücrelerde aranan değeri ortak yazıp arama ile renklendirdikten sonra,
‘-----makro kaydı açıp tüm hücreleri renge göre sırala seçmeli,
‘-----sonra makro durdurup oluşan kodu aşağıya yapıştırmalı.
Private Sub CommandButton2_Click()
Range("Tablo2[[#Headers],[Klasör]]").Select
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[Klasör]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[Kamera Adı]"), xlSortOnCellColor, xlAscending, , xlSortNormal _
).SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[Model]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[Seri No]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[MAC Adres]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _
SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[IP]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[Yazılım Sürümü]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[Not 1]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(144, 238, 144)
ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort.SortFields. _
Add(Range("Tablo2[Not 2]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _
SortOnValue.Color = RGB(144, 238, 144)
With ActiveWorkbook.Worksheets("Dashboard").ListObjects("Tablo2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
‘-----Renkli hücre (Yeşil) sayısını bulma işlemi-----
‘-----Bu kodun birinci kullanım yeri de burası-----
'Sub RenkliHucreSayisiBul()
Dim sayfa As Worksheet
Dim hucre As Range
Dim renkKodu As Long
Dim sayac As Long
Set sayfa = ActiveSheet
' Aradığımız rengin RGB kodu, RGB(144, 238, 144) = Açık yeşil tonu
renkKodu = RGB(144, 238, 144)
sayac = 0
For Each hucre In sayfa.UsedRange
If hucre.Interior.Color = renkKodu Then
sayac = sayac + 1
End If
Next hucre
' Sonucu X5 hücresine yaz, =X5 ile istediğimiz hücreye kopyasını yazdırırız.
sayfa.Range("X5").Value = sayac
Range("A1").Select
End Sub
‘-----Texbox içinde arama yapma, Büyük küçük harf uyumlu-----
‘-----(Aşağıdaki kodu, Texbox çift tıklayınca açılan koda yapıştır-----
Private Sub TextBox1_Change()
Dim aralik As Range
Dim hucre As Range
Dim normalizedSearch As String ' Normalize edilmiş arama metni
Dim normalizedCell As String ' Normalize edilmiş hücre metni
' Metin kutusundaki yazının boyutu
Me.TextBox1.Font.Italic = False
Me.TextBox1.Font.Size = 16
' 1. Arama metnini alın.
normalizedSearch = Me.TextBox1.Text
' KRİTİK ADIM 1: Arama metnini tüm Türkçe büyük harfler için normalize edin.
' Bu, LCase'den önce tüm Türkçe büyük harfleri doğru küçük harflere çevirerek eşleşme sağlar.
normalizedSearch = Replace(normalizedSearch, "İ", "i")
normalizedSearch = Replace(normalizedSearch, "I", "ı")
normalizedSearch = Replace(normalizedSearch, "Ş", "ş")
normalizedSearch = Replace(normalizedSearch, "Ç", "ç")
normalizedSearch = Replace(normalizedSearch, "Ğ", "ğ")
normalizedSearch = Replace(normalizedSearch, "Ö", "ö")
normalizedSearch = Replace(normalizedSearch, "Ü", "ü")
' Geri kalan normal harfleri (A, B, C...) küçük harfe çevirme
normalizedSearch = LCase(normalizedSearch)
' Aranacak aralığı belirleyin
Set aralik = ThisWorkbook.Sheets("Dashboard").Range("B24:J653")
' Önceki tüm vurguları temizleyin
aralik.Interior.Color = xlNone
' Eğer metin kutusu boş değilse, aramayı yapın
If normalizedSearch <> "" Then
' Aralıktaki her hücreyi döngüye alın
For Each hucre In aralik
' Hücre değerini alın ve string'e çevirin (hata almamak için)
normalizedCell = CStr(hucre.Value)
' KRİTİK ADIM 2: Hücre değerini de aynı şekilde tüm Türkçe büyük harfler için normalize edin.
normalizedCell = Replace(normalizedCell, "İ", "i")
normalizedCell = Replace(normalizedCell, "I", "ı")
normalizedCell = Replace(normalizedCell, "Ş", "ş")
normalizedCell = Replace(normalizedCell, "Ç", "ç")
normalizedCell = Replace(normalizedCell, "Ğ", "ğ")
normalizedCell = Replace(normalizedCell, "Ö", "ö")
normalizedCell = Replace(normalizedCell, "Ü", "ü")
' Geri kalan normal harfleri (A, B, C...) küçük harfe çevirme
normalizedCell = LCase(normalizedCell)
' Normalize edilmiş iki küçük harfli metni karşılaştırın.
If InStr(1, normalizedCell, normalizedSearch) > 0 Then
' Eşleşme bulundu, hücreyi açık yeşil yapın
hucre.Interior.Color = RGB(144, 238, 144) ' Açık yeşil tonu
' Hücrenin metin rengini siyah yapın
hucre.Font.Color = RGB(0, 0, 0)
End If
Next hucre
End If
End Sub
'---Sayfa Kapat-Gizle---(Ön izleme modu)
Sub Kapat()
Application.WindowState = xlMaximized
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
Application.DisplayFormulaBar = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
Next ws
ThisWorkbook.Sheets(1).Activate
ActiveSheet.Range("A1").Select
ActiveWorkbook.Save
End Sub
'---Sayfa Aç---
Sub Ac()
Application.WindowState = xlMaximized
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", True)"
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = True
Next ws
Application.DisplayFormulaBar = True
ThisWorkbook.Sheets(1).Activate
Range("A1").Select
ActiveWorkbook.Save
End Sub
‘***Adet, Yüzde Oranı, Filtre Adet***
‘===Adet===:
‘ Hücre: M3
‘ =ALTTOPLAM(103;Tablo2[Klasör])
‘ Hücre: N3
‘=O3-M3
‘ Hücre: O3
‘ “Toplam değer manuel girilir”
‘===Yüzde Oranı===:
‘ Hücre: M4
‘ =M3*100/631 “Sondaki toplam değer manuel girilir” “Kullanılan Oran”
‘ Hücre: N4
‘=N3*100/631 “Kalan oran”
‘ Hücre: O4
‘ “100” değeri manuel girilir Yüzde yüzün diğer parçası için”
‘===Filtre Adet===:
‘ “X5” kod ile gelen sonucun yazıldığı yer
‘ “X4” 100
‘ “Y4” 0
‘ “Z4” 100
‘ “AA” =X5 hücresi sayı virgülsüz noktalı biçimlendirilmiş, Adet bilgisi bu hücre gösterilecek.
(84) Excel, Metin arama (Büyük/Küçük harf) -- Satırları büyük ve kalın yapma
' --Satırları büyük ve kalın yapma--
'--------------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' Tıklanan Satır kalın ve büyük olsun
'
Const ANA_ARALIK As String = "B16:I1000" ' ARALIK GÜNCELLENDİ
Const BUYUK_BOYUT As Long = 12
Const KUCUK_BOYUT As Long = 11
On Error GoTo HataYakala
Application.EnableEvents = False
' A1'e tıklandığında tüm ANA_ARALIK'ı küçük boyuta ve normal (kalınsız) yap.
If Target.Address(False, False) = "A1" Then
With Me.Range(ANA_ARALIK).Font
.Size = KUCUK_BOYUT
.Bold = False ' Tüm aralığı kalın yapma özelliğini kaldır.
End With
GoTo HataYakala
End If
' Ana aralık dışında bir yere tıklandıysa çık.
If Intersect(Target, Me.Range(ANA_ARALIK)) Is Nothing Then GoTo HataYakala
' Tek bir hücre seç.
If Target.Cells.CountLarge > 1 Then Set Target = Target.Cells(1, 1)
' Önce tüm aralığı küçült ve kalınsız yap.
With Me.Range(ANA_ARALIK).Font
.Size = KUCUK_BOYUT
.Bold = False ' Önceki kalın ayarını kaldır.
End With
' Sonra seçili satırı (B sütunundan N sütununa kadar) büyüt VE kalın (Bold = True) yap.
With Me.Range("B" & Target.Row & ":I" & Target.Row).Font ' N SÜTUNU BURADA GÜNCELLENDİ
.Size = BUYUK_BOYUT
.Bold = True ' Tıklanan satırı kalın yap.
End With
HataYakala:
Application.EnableEvents = True
End Sub
(83) Excel, "X5" hücre içeriğini temizle ve "A1"hücresine tıkla/dön. (Makro) kodu:
Range("X5").Select
Selection.ClearContents
Range("A1").Select
(82) Excel "TextBox" Arama penceresinde İtalik yazmasın. Arama yapsın ve sonuç hücreleri renklendirsin. (Makro) kodu:
Private Sub TextBox1_Change()
' Bul Filtrele "Texbox kutusu"
Dim aralik As Range
Dim hucre As Range
Dim metin As String
' Metin kutusundaki yazının boyutunu 30 punta ayarlar
Me.TextBox1.Font.Italic = False
Me.TextBox1.Font.Size = 30
' Metin kutusundaki değeri alın ve küçük harfe çevirin
metin = LCase(Me.TextBox1.Text)
' Aranacak aralığı belirleyin
Set aralik = ThisWorkbook.Sheets("Tüm Daireler (BT) Envanter").Range("H26:I7931") ' "Sayfa1" yazan yere sayfanızın adını yazmalısınız
' Tüm hücrelerin arka plan rengini varsayılan (renksiz) olarak ayarlayın
aralik.Interior.Color = xlNone
' Eğer metin kutusu boş değilse
If metin <> "" Then
' Aralıktaki her hücreyi döngüye alın
For Each hucre In aralik
' Eğer hücrenin değeri metin kutusundaki değeri içeriyorsa (büyük/küçük harf duyarsız)
If InStr(1, LCase(hucre.Value), metin) > 0 Then
' Hücrenin arka plan rengini açık yeşil yapın
hucre.Interior.Color = RGB(144, 238, 144) ' Açık yeşil tonu
' Hücrenin metin rengini siyah yapın
hucre.Font.Color = RGB(0, 0, 0)
End If
Next hucre
End If
End Sub
(81) Excel'de belirli bir aralıkta (B26:H5000) bir satıra tıklandığında, o satırın Yazı tipi boyutunu 12 ve Kalın font yapacak. Aynı aralıktaki diğer tüm satırların yazı tipi boyutunu 10'e Kalın font olmayacak. A1 hücresine tıklanınca da (B3:H5000) aralıktaki tüm satırların yazı tipi boyutunu 10 ve Kalın fontsuz olacak. VBA (Makro) kodu:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const ANA_ARALIK As String = "B26:N5000" ' ARALIK GÜNCELLENDİ
Const BUYUK_BOYUT As Long = 12
Const KUCUK_BOYUT As Long = 10
On Error GoTo HataYakala
Application.EnableEvents = False
' A1'e tıklandığında tüm ANA_ARALIK'ı küçük boyuta ve normal (kalınsız) yap.
If Target.Address(False, False) = "A1" Then
With Me.Range(ANA_ARALIK).Font
.Size = KUCUK_BOYUT
.Bold = False ' Tüm aralığı kalın yapma özelliğini kaldır.
End With
GoTo HataYakala
End If
' Ana aralık dışında bir yere tıklandıysa çık.
If Intersect(Target, Me.Range(ANA_ARALIK)) Is Nothing Then GoTo HataYakala
' Tek bir hücre seç.
If Target.Cells.CountLarge > 1 Then Set Target = Target.Cells(1, 1)
' Önce tüm aralığı küçült ve kalınsız yap.
With Me.Range(ANA_ARALIK).Font
.Size = KUCUK_BOYUT
.Bold = False ' Önceki kalın ayarını kaldır.
End With
' Sonra seçili satırı (B sütunundan N sütununa kadar) büyüt VE kalın (Bold = True) yap.
With Me.Range("B" & Target.Row & ":N" & Target.Row).Font ' N SÜTUNU BURADA GÜNCELLENDİ
.Size = BUYUK_BOYUT
.Bold = True ' Tıklanan satırı kalın yap.
End With
HataYakala:
Application.EnableEvents = True
End Sub
(80) Excel'de belirli bir aralıkta (B3:H23) bir satıra tıklandığında, o satırın yazı tipi boyutunu 16 yapacak ve aynı aralıktaki diğer tüm satırların yazı tipi boyutunu 11'e geri döndürecek. A1 hücresine tıklanınca da (B3:H23) aralıktaki diğer tüm satırların yazı tipi boyutunu 11'e geri döndürecek VBA (Makro) kodu:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const ANA_ARALIK As String = "B3:H22"
Const BUYUK_BOYUT As Long = 16
Const KUCUK_BOYUT As Long = 11
On Error GoTo HataYakala
Application.EnableEvents = False
' A1'e tıklandığında tüm B3:H22 aralığını küçük boyuta ayarla.
If Target.Address(False, False) = "A1" Then
Me.Range(ANA_ARALIK).Font.Size = KUCUK_BOYUT
GoTo HataYakala
End If
' Ana aralık dışında bir yere tıklandıysa çık.
If Intersect(Target, Me.Range(ANA_ARALIK)) Is Nothing Then GoTo HataYakala
' Tek bir hücre seç.
If Target.Cells.CountLarge > 1 Then Set Target = Target.Cells(1, 1)
' Tüm aralığı küçült, sonra seçili satırı büyüt.
Me.Range(ANA_ARALIK).Font.Size = KUCUK_BOYUT
Me.Range("B" & Target.Row & ":H" & Target.Row).Font.Size = BUYUK_BOYUT
HataYakala:
Application.EnableEvents = True
End Sub
(79) "Saat/Dakika/Saniyeyi" Toplam Dakikaya Çevirme Formülü
Örnek saat: "01:46:30" (Saat A2 hücresinde)
Formül: =A1∗24∗60 (Hücre biçimi, Genel)
Sonuç:106,5 (Hücre biçimi, Sayı)