Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Haziran 2004 Pazar

Interior Descriptions


'Module1

Sub KırmızıSatırıSil()
On Error Resume Next
Dim Hücre As Range, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set Hücre = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For i = Hücre.Count To 1 Step -1
If Hücre.Item(i).Interior.ColorIndex = 3 Then
Hücre.Item(i).EntireRow.Delete
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub BoşDoluHücreleriRenklendir()
On Error Resume Next
Dim Hücre As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Hücre In Intersect(Selection, ActiveCell.EntireColumn, ActiveSheet.UsedRange)
Select Case Hücre.Value
Case (Is >= 50)
Hücre.EntireRow.Interior.ColorIndex = 20
Case (Is >= 40)
Hücre.EntireRow.Interior.ColorIndex = 37
Case (Is >= 20)
Hücre.EntireRow.Interior.ColorIndex = 38
Case (Is >= 0)
Hücre.EntireRow.Interior.ColorIndex = 36
Case Else
Hücre.EntireRow.Interior.ColorIndex = 44
End Select
Next Hücre
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub 

'Sheets("Sayfa1") Module

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("A1:B10")) Is Nothing Then Exit Sub
If (Target.Value > 10) Then
Target.Interior.ColorIndex = 6
Else
Target.Interior.ColorIndex = xlNone
End If
End Sub

10 Haziran 2004 Perşembe

Select and Selection


'Module1

Sub AktifKolonuSeç()
On Error Resume Next
Selection.EntireColumn.Select
End Sub
Sub AktifSatırıSeç()
On Error Resume Next
Selection.EntireRow.Select
End Sub
Sub TümHücreleriSeç()
On Error Resume Next
Cells.Select
End Sub
Sub DoluHücreninAltındakiBoşHücreyiSeç()
On Error Resume Next
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub AktifHücreninSağındakiBoşHücreyiSeç()
On Error Resume Next
ActiveCell.Offset(0, 1).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Select
Loop
End Sub
Sub AktifHücreninSağveSolundakiDoluHücreyiSeç()
On Error Resume Next
Set LeftCell = Cells(ActiveCell.Row, 1)
Set RightCell = Cells(ActiveCell.Row, 256)
If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)
If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)
If LeftCell.Column = 256 And RightCell.Column = 1 Then ActiveCell.Select Else Range(LeftCell, RightCell).Select
End Sub
Sub AktifHücreninAltındakiTümHücreleriSeç()
On Error Resume Next
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End Sub
Sub AyrıAlanlardakiHücreleriSeç()
On Error Resume Next
Application.ScreenUpdating = False
Dim r1 As Range, r2 As Range, rAll As Range
Set r1 = Range("A1", "A3")
Set r2 = Range("C3", "C8")
Set rAll = Union(r1, r2)
rAll.Select
End Sub
Sub AktifHücreninÜçSatırAltıİkiKolonÖnündekiniSeç()
On Error Resume Next
ActiveCell.Offset(3, 2).Select
End Sub

1 Haziran 2004 Salı

Forumula to Value

'Module1

Sub FormülleriDeğereÇevirme()
     On Error Resume Next
     For Each Hücre In Selection.Cells 

           Hücre.Formula = Hücre.Value
     Next Hücre
End Sub

Blog Arşivi

Gadget

Bu içerik henüz şifreli bağlantı üzerinden kullanılamıyor.

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul
Anadolu Üniversitesi Açık Öğretim Fakültesi