Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Eylül 2004 Çarşamba

Data Sort on Sheet





'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Name: VBA, Description: Visual Basic For Applications, Full Path: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL'Name: Excel, Description: Microsoft Excel 11.0 Object Library, Full Path: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE'Name: stdole, Description: OLE Automation, Full Path: C:\WINDOWS\system32\stdole2.tlb
'Name: Office, Description: Microsoft Office 11.0 Object Library, Full Path: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL'Name: MSForms, Description: Microsoft Forms 2.0 Object Library, Full Path: C:\WINDOWS\system32\FM20.DLL
'B) UserForm1'e Eklenen Araçlar (Add Tools)
'ListBox1, CommandButton1, CommandButton2, Label1
Option Explicit
Dim i, j As Single
Dim Hücre As Range
Dim Bellek(1 To 20, 1 To 10)
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Data Sort on Sheet"
Call EkranDüzenle
Call VeriDüzenle
End Sub
Private Sub CommandButton1_Click()
'Number Sort

On Error GoTo 0
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Call Sırala
End Sub
Private Sub CommandButton2_Click()
'Name Sort

On Error GoTo 0
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Call Sırala
End Sub
Private Sub Sırala()
'Sort

On Error GoTo 0
i = 1: j = 1
For Each Hücre In Sheets(1).Range("A1:B81")
If Hücre.Column = 1 Then
If i > 0 And i <= 20 Then Bellek(j, 1) = Hücre.Value
If i > 20 And i <= 40 Then Bellek(j, 3) = Hücre.Value
If i > 40 And i <= 60 Then Bellek(j, 5) = Hücre.Value
If i > 60 And i <= 80 Then Bellek(j, 7) = Hücre.Value
If i > 80 And i <= 100 Then Bellek(j, 9) = Hücre.Value
Else
If i > 0 And i <= 20 Then Bellek(j, 2) = Hücre.Value
If i > 20 And i <= 40 Then Bellek(j, 4) = Hücre.Value
If i > 40 And i <= 60 Then Bellek(j, 6) = Hücre.Value
If i > 60 And i <= 80 Then Bellek(j, 8) = Hücre.Value
If i > 80 And i <= 100 Then Bellek(j, 10) = Hücre.Value
i = i + 1
j = j + 1
If (j > 20) Then j = 1
End If
Next Hücre
ListBox1.List() = Bellek
End Sub
Private Sub EkranDüzenle()
'Form Creation

On Error Resume Next
With Me
.Height = 258
.Width = 444
.BackColor = vbWhite
With ListBox1
.Left = 6
.Top = 6
.Height = 204
.Width = 428
.TextAlign = fmTextAlignLeft
.SpecialEffect = fmSpecialEffectEtched
.BackColor = vbWhite
.ColumnCount = 10
.ColumnWidths = "18 pt;66 pt;18 pt;66 pt;18 pt;66 pt;18 pt;66 pt;18 pt;66 pt"
.Clear
.BackColor = &H80000013
.ForeColor = vbBlue
End With
With CommandButton1
.Left = 6
.Top = ListBox1.Top + ListBox1.Height + 6
.Width = 72
.Height = 18
.Caption = "Number Sort"
End With
With CommandButton2
.Left = CommandButton1.Left + CommandButton1.Width + 6
.Top = ListBox1.Top + ListBox1.Height + 6
.Width = 72
.Height = 18
.Caption = "Name Sort"
End With
With Label1
.Top = ListBox1.Top + ListBox1.Height + 6
.Left = CommandButton2.Left + CommandButton2.Width + 6
.Height = 12
.Width = 270
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.ForeColor = vbBlue
.Caption = "Mustafa ULUSARAÇ, 01ulusarac@superonline.com"
End With
End With
End Sub
Private Sub VeriDüzenle()
'Data Creation

On Error Resume Next
Sheets(1).Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Cells(1, 1) = 1: Cells(1, 2) = "Adana"
Cells(2, 1) = 2: Cells(2, 2) = "Adıyaman"
Cells(3, 1) = 3: Cells(3, 2) = "Afyon"
Cells(4, 1) = 4: Cells(4, 2) = "Ağrı"
Cells(5, 1) = 5: Cells(5, 2) = "Amasya"
Cells(6, 1) = 6: Cells(6, 2) = "Ankara"
Cells(7, 1) = 7: Cells(7, 2) = "Antalya"
Cells(8, 1) = 8: Cells(8, 2) = "Artvin"
Cells(9, 1) = 9: Cells(9, 2) = "Aydın"
Cells(10, 1) = 10: Cells(10, 2) = "Balıkesir"
Cells(11, 1) = 11: Cells(11, 2) = "Bilecik"
Cells(12, 1) = 12: Cells(12, 2) = "Bingöl"
Cells(13, 1) = 13: Cells(13, 2) = "Bitlis"
Cells(14, 1) = 14: Cells(14, 2) = "Bolu"
Cells(15, 1) = 15: Cells(15, 2) = "Burdur"
Cells(16, 1) = 16: Cells(16, 2) = "Bursa"
Cells(17, 1) = 17: Cells(17, 2) = "Çanakkale"
Cells(18, 1) = 18: Cells(18, 2) = "Çankırı"
Cells(19, 1) = 19: Cells(19, 2) = "Çorum"
Cells(20, 1) = 20: Cells(20, 2) = "Denizli"
Cells(21, 1) = 21: Cells(21, 2) = "Diyarbakır"
Cells(22, 1) = 22: Cells(22, 2) = "Edirne"
Cells(23, 1) = 23: Cells(23, 2) = "Elazığ"
Cells(24, 1) = 24: Cells(24, 2) = "Erzincan"
Cells(25, 1) = 25: Cells(25, 2) = "Erzurum"
Cells(26, 1) = 26: Cells(26, 2) = "Eskişehir"
Cells(27, 1) = 27: Cells(27, 2) = "Gaziantep"
Cells(28, 1) = 28: Cells(28, 2) = "Giresun"
Cells(29, 1) = 29: Cells(29, 2) = "Gümüşhane"
Cells(30, 1) = 30: Cells(30, 2) = "Hakkari"
Cells(31, 1) = 31: Cells(31, 2) = "Hatay"
Cells(32, 1) = 32: Cells(32, 2) = "Isparta"
Cells(33, 1) = 33: Cells(33, 2) = "İçel"
Cells(34, 1) = 34: Cells(34, 2) = "İstanbul"
Cells(35, 1) = 35: Cells(35, 2) = "İzmir"
Cells(36, 1) = 36: Cells(36, 2) = "Kars"
Cells(37, 1) = 37: Cells(37, 2) = "Kastamonu"
Cells(38, 1) = 38: Cells(38, 2) = "Kayseri"
Cells(39, 1) = 39: Cells(39, 2) = "Kırklareli"
Cells(40, 1) = 40: Cells(40, 2) = "Kırşehir"
Cells(41, 1) = 41: Cells(41, 2) = "Kocaeli"
Cells(42, 1) = 42: Cells(42, 2) = "Konya"
Cells(43, 1) = 43: Cells(43, 2) = "Kütahya"
Cells(44, 1) = 44: Cells(44, 2) = "Malatya"
Cells(45, 1) = 45: Cells(45, 2) = "Manisa"
Cells(46, 1) = 46: Cells(46, 2) = "Kahramanmaraş"
Cells(47, 1) = 47: Cells(47, 2) = "Mardin"
Cells(48, 1) = 48: Cells(48, 2) = "Muğla"
Cells(49, 1) = 49: Cells(49, 2) = "Muş"
Cells(50, 1) = 50: Cells(50, 2) = "Nevşehir"
Cells(51, 1) = 51: Cells(51, 2) = "Niğde"
Cells(52, 1) = 52: Cells(52, 2) = "Ordu"
Cells(53, 1) = 53: Cells(53, 2) = "Rize"
Cells(54, 1) = 54: Cells(54, 2) = "Sakarya"
Cells(55, 1) = 55: Cells(55, 2) = "Samsun"
Cells(56, 1) = 56: Cells(56, 2) = "Siirt"
Cells(57, 1) = 57: Cells(57, 2) = "Sinop"
Cells(58, 1) = 58: Cells(58, 2) = "Sivas"
Cells(59, 1) = 59: Cells(59, 2) = "Tekirdağ"
Cells(60, 1) = 60: Cells(60, 2) = "Tokat"
Cells(61, 1) = 61: Cells(61, 2) = "Trabzon"
Cells(62, 1) = 62: Cells(62, 2) = "Tunceli"
Cells(63, 1) = 63: Cells(63, 2) = "Şanlıurfa"
Cells(64, 1) = 64: Cells(64, 2) = "Uşak"
Cells(65, 1) = 65: Cells(65, 2) = "Van"
Cells(66, 1) = 66: Cells(66, 2) = "Yozgat"
Cells(67, 1) = 67: Cells(67, 2) = "Zonguldak"
Cells(68, 1) = 68: Cells(68, 2) = "Aksaray"
Cells(69, 1) = 69: Cells(69, 2) = "Bayburt"
Cells(70, 1) = 70: Cells(70, 2) = "Karaman"
Cells(71, 1) = 71: Cells(71, 2) = "Kırıkkale"
Cells(72, 1) = 72: Cells(72, 2) = "Batman"
Cells(73, 1) = 73: Cells(73, 2) = "Şırnak"
Cells(74, 1) = 74: Cells(74, 2) = "Bartın"
Cells(75, 1) = 75: Cells(75, 2) = "Ardahan"
Cells(76, 1) = 76: Cells(76, 2) = "Iğdır"
Cells(77, 1) = 77: Cells(77, 2) = "Yalova"
Cells(78, 1) = 78: Cells(78, 2) = "Karabük"
Cells(79, 1) = 79: Cells(79, 2) = "Kilis"
Cells(80, 1) = 80: Cells(80, 2) = "Osmaniye"
Cells(81, 1) = 81: Cells(81, 2) = "Düzce"
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