Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Aralık 2007 Pazartesi

Condition Statements (Select Case, For Each, For Next, Do Loop, Do While, While)


'Module1

Sub DÖNGÜ_ForNext()
On Error GoTo Hata:
Dim Hafıza(1 To 24, 1 To 1)
For i = 1 To 24
Hafıza(i, 1) = i
Next i
[A1:A24].Value = Hafıza
For Sayaç = 1 To 24
If (Cells(Sayaç, 1) > 20) Then
With Cells(Sayaç, 2)
.Value = Application.WorksheetFunction.Max(Range(Cells(1, 2), Cells(24, 2))) + 1
With .Interior
.ColorIndex = 4
.Pattern = xlPatternCrissCross
End With
With .Font
.Bold = True
.Color = vbWhite
End With
End With
End If
Next Sayaç
Hata:
End Sub
Sub DÖNGÜ_ForEachNext()
On Error GoTo Hata:
Dim Hafıza(1 To 65536, 1 To 1)
For i = 1 To 65536
Hafıza(i, 1) = VBA.Rnd
Next i
[A1:A65536].Value = Hafıza
For Each Hücre In Range("A1:A65536")
If (Hücre.Value > 0.6) Then
With Hücre.Offset(0, 1).Interior

.ColorIndex = 6
.Pattern = xlSolid
End With
End If
Next Hücre
Hata:
End Sub
Sub DÖNGÜ_SelectCase()
On Error GoTo Hata:
Dim Bulgu
Dim Hafıza(1 To 12, 1 To 1)
For i = 1 To 12
Hafıza(i, 1) = i
Next i
[A1:A12].Value = Hafıza
[A6].Select
Bulgu = Selection.Offset(0, 0).Row
Select Case Bulgu
Case 1 :Selection.Offset(0, 1) = Selection.Row
Case 2 :Selection.Offset(0, 1) = Selection.Row
Case 3 :Selection.Offset(0, 1) = Selection.Row
Case 4 :Selection.Offset(0, 1) = Selection.Row
Case 5 :Selection.Offset(0, 1) = Selection.Row
Case 6 :Selection.Offset(0, 1) = Selection.Row
Case 7 :Selection.Offset(0, 1) = Selection.Row
Case 8 :Selection.Offset(0, 1) = Selection.Row
Case 9 :Selection.Offset(0, 1) = Selection.Row
Case 10 :Selection.Offset(0, 1) = Selection.Row
Case 11 :Selection.Offset(0, 1) = Selection.Row
Case 12 :Selection.Offset(0, 1) = Selection.Row
End Select
Hata:
End Sub Sub DÖNGÜ_DoLoop1()
On Error GoTo Hata:
Do
Range("A1") = Range("A1") + 1
Loop
Hata:
End Sub
Sub DÖNGÜ_DoLoop2()
On Error GoTo Hata:
Do
Range("A1") = Range("A1") + 1
If Range("A1") = 50 Then Exit Do
Loop
Hata:
End Sub
Sub DÖNGÜ_DoUntilLoop1()
On Error GoTo Hata:
Dim i As Single
Dim Satır As Double
Dim Hafıza(1 To 40, 1 To 1)
Satır = 0
[A1].Select
For i = 1 To 40
Hafıza(i, 1) = i
Next i
[A1:A40].Value = Hafıza
Do Until (Selection.Offset(Satır, 0).Row > 20)
If (Selection.Offset(Satır, 0).Value <> "") Then
With Selection.Offset(Satır, 1)
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid
.Offset(Satır, 1) = Selection.Offset(Satır, 0).Row
End With
End If
Selection.Offset(Satır + 1, 0).Select
Loop
Hata:
End Sub
Sub DÖNGÜ_DoUntilLoop2()
On Error Resume Next
Dim i As Integer
Dim Ölçüt(1 To 4) As String
Dim Karşılık As String
Dim İşaret As Boolean
İşaret = False
Ölçüt(1) = "A"
Ölçüt(2) = "B"
Ölçüt(3) = "C"
Ölçüt(4) = "D"
Do Until İşaret = True
Karşılık = InputBox("Lütfen kendi seçiminizi giriniz: (A,B,C or D)")
For i = 1 To 4
If UCase(Karşılık) = UCase(Ölçüt(i)) Then
İşaret = True: Exit For
End If
Next i
Loop
End Sub
Sub DÖNGÜ_DoUntilLoop3()
On Error Resume Next
If IsEmpty(ActiveCell) Then Exit Sub
Do Until IsEmpty(ActiveCell)
MsgBox ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub DÖNGÜ_DoUntilLoop4()
On Error Resume Next
Dim i As Integer
Dim Dosya As String
Dosya = Dir("C:\*.XLS")
i = 1
Do Until Dosya = ""
Cells(i, 1) = Dosya
Dosya = Dir
i = i + 1
Loop
End Sub
Sub DÖNGÜ_DoLoopUntil()
On Error GoTo Hata:
Dim i As Integer
i = 1
Do
Cells(i, 1).Value = i
i = i + 1
Loop Until (i > 10)
Hata:
End Sub
Sub DÖNGÜ_GoTo1()
On Error GoTo Hata:
Dim i As Integer
i = InputBox("1-100 arasında bir sayı giriniz")
GoTo Topla
Topla:
i = i + 20
MsgBox "Girdiğiniz sayının 20 fazlası:" & i
Hata:
End Sub
Sub DÖNGÜ_GoTo2()
On Error GoTo Hata:
If IsEmpty(ActiveCell) Then Exit Sub
Top:
MsgBox ActiveCell.Value
ActiveCell.Offset(1, 0).Select
If Not IsEmpty(ActiveCell) Then GoTo Top
Hata:
End Sub
Sub DÖNGÜ_While()
On Error GoTo Hata:
Dim Değer As Variant
Dim Sayaç, Topla As Double
Değer = Val(InputBox("Sıfırdan farklı değer giriniz"))
Sayaç = 0
Topla = 0
While Değer > 0
Topla = Topla + Değer
Sayaç = Sayaç + 1
Değer = Val(InputBox("Sonraki deger"))
Wend
MsgBox ("Toplanan Adet: " & Sayaç & " Toplam Değer: " & Topla)
Hata:
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

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