(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ı)