Makro Kod Listesi
Excel de kullanılan Makro Kodlarının Listesi


vergi iadesi hesaplama

ID : 2401
ISLEM : vergi iadesi hesaplama
MAKRO KODU : Private Sub CommandButton1_Click() If TextBox1 > 1 And TextBox1 -

veri aktarma...

ID : 2402
ISLEM : veri aktarma...
MAKRO KODU : Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim r As Integer r = Cells(65536, 2).End(xlUp).Row Cells(r + 1, 2) = Range("a1") Application.ScreenUpdating = True End Sub

veri bulur

ID : 2403
ISLEM : veri bulur
MAKRO KODU : VERİLERİ BULUR Private Sub CommandButton6_Click() Dim bak As Range For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then bak.Select TextBox1.Value = ActiveCell.Offset(0, -1).Value TextBox2.Value = ActiveCell.Offset(0, 1).Value TextBox3.Value = ActiveCell.Offset(0, 2).Value Exit Sub End If Next bak MsgBox "Aradığınız isimde bir kayıt bulunamadı" End Sub 'VERİ ARATIRKEN SÜTUN SEÇİMİNİ GENİŞ TUTARSAK BÜTÜN SAYFADA VERİ ARATABİLİRİZ. Private Sub CommandButton1_Click() Dim bak As Range For Each bak In Range("a1:ıv" & WorksheetFunction.CountA(Range("a1:ıv65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then bak.Select Exit Sub End If Next bak MsgBox "Aradığınız isimde bir kayıt bulunamadı" End Sub

veri bulur

ID : 2404
ISLEM : veri bulur
MAKRO KODU : VERİLERİ BULUR Private Sub CommandButton6_Click() Dim bak As Range For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then bak.Select TextBox1.Value = ActiveCell.Offset(0, -1).Value TextBox2.Value = ActiveCell.Offset(0, 1).Value TextBox3.Value = ActiveCell.Offset(0, 2).Value Exit Sub End If Next bak MsgBox "Aradığınız isimde bir kayıt bulunamadı" End Sub 'VERİ ARATIRKEN SÜTUN SEÇİMİNİ GENİŞ TUTARSAK BÜTÜN SAYFADA VERİ ARATABİLİRİZ. Private Sub CommandButton1_Click() Dim bak As Range For Each bak In Range("a1:ıv" & WorksheetFunction.CountA(Range("a1:ıv65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then bak.Select Exit Sub End If Next bak MsgBox "Aradığınız isimde bir kayıt bulunamadı" End Sub

veri değiştirir

ID : 2405
ISLEM : veri değiştirir
MAKRO KODU : VERİLERİ DEĞİŞTİRİR (DÜZENLEME YAPILANLARI KAYDEDER) Private Sub CommandButton8_Click() Dim bak As Range For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then bak.Select ActiveCell.Value = ComboBox1.Value ActiveCell.Offset(0, 1).Value = TextBox2.Value ActiveCell.Offset(0, 2).Value = TextBox3.Value Workbooks("KİTAP2.XLS").Save MsgBox "Verileriniz Başarıyla Değiştirildi", , "KAYIT" ComboBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1 Unload UserForm1 UserForm1.Show Exit Sub End If Next bak End Sub

veri değiştirir

ID : 2406
ISLEM : veri değiştirir
MAKRO KODU : VERİLERİ DEĞİŞTİRİR (DÜZENLEME YAPILANLARI KAYDEDER) Private Sub CommandButton8_Click() Dim bak As Range For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then bak.Select ActiveCell.Value = ComboBox1.Value ActiveCell.Offset(0, 1).Value = TextBox2.Value ActiveCell.Offset(0, 2).Value = TextBox3.Value Workbooks("KİTAP2.XLS").Save MsgBox "Verileriniz Başarıyla Değiştirildi", , "KAYIT" ComboBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1 Unload UserForm1 UserForm1.Show Exit Sub End If Next bak End Sub

veri değiştirirken uyari alma

ID : 2407
ISLEM : veri değiştirirken uyari alma
MAKRO KODU : Eğer Sizin çalışma kitabınızı sizden başkasının değiştirip kaydetmesini istemiyorsanız ki sorunuzdan bunu anladım şöyle bir koruma altına alabilirsiniz.Kodları ThisWorkbooka yazın.Kayıt şifresi:xxrt Kod: Private Sub Workbook_BeforeSave _ (ByVal SaveAsUI As Boolean, Cancel As Boolean) sifre = InputBox("Kayıt için şifreyi girmelisiniz", _ "KAYIT", "şifre girin") If sifre = "xxrt" Then MsgBox "Kayıt işlemi tamamlandı", vbInformation, _ "KAYIT BAÞARILI" Else MsgBox "Yanlış şifre girdiniz." & Chr(13) & _ "Dosya kaydedilemedi", vbCritical, "HATALI ÞİFRE" Cancel = True End If End Sub

veri girme görme

ID : 2408
ISLEM : veri girme görme
MAKRO KODU : VERİ GÖRME LİSTE KUTUSU Private Sub ListBox1_Click() TextBox1.Value = ListBox1.Value End Sub VERİ GİRME LİSTE KUTUSU Private Sub TextBox1_Change() End Sub VERİ GİRME LİSTE KUTUSU Private Sub TextBox2_Change() End Sub VERİ GİRME LİSTE KUTUSU Private Sub TextBox3_Change() End Sub

veri girme görme

ID : 2409
ISLEM : veri girme görme
MAKRO KODU : VERİ GÖRME LİSTE KUTUSU Private Sub ListBox1_Click() TextBox1.Value = ListBox1.Value End Sub VERİ GİRME LİSTE KUTUSU Private Sub TextBox1_Change() End Sub VERİ GİRME LİSTE KUTUSU Private Sub TextBox2_Change() End Sub VERİ GİRME LİSTE KUTUSU Private Sub TextBox3_Change() End Sub

veri kaydırır

ID : 2410
ISLEM : veri kaydırır
MAKRO KODU : DEĞER DEĞİŞTİRİCİ BUTONU İŞLEVİ Private Sub SpinButton1_Change() TextBox1 = SpinButton1 'DEĞERİN DEĞİŞTİRİLECEĞİ TextBox%SpinButton End Sub 'COMBOBOX&TEXTBOX'DAKİ VERİLERİ AŞŞAĞI DOĞRU KAYDIRIR. Private Sub SpinButton2_Change() TextBox1.Value = ActiveCell.Offset(0, 0).Value ComboBox1.Value = ActiveCell.Offset(0, 1).Value TextBox3.Value = ActiveCell.Offset(0, 2).Value TextBox4.Value = ActiveCell.Offset(0, 3).Value TextBox5.Value = ActiveCell.Offset(0, 4).Value TextBox6.Value = ActiveCell.Offset(0, 5).Value ActiveCell.Offset(1, 0).Select 'BİRER BİRER HÜC.AŞŞAĞI KAYDIRIR. End Sub

veri kaydirir

ID : 2411
ISLEM : veri kaydirir
MAKRO KODU : DEĞER DEĞİŞTİRİCİ BUTONU İŞLEVİ Private Sub SpinButton1_Change() TextBox1 = SpinButton1 'DEĞERİN DEĞİŞTİRİLECEĞİ TextBox%SpinButton End Sub 'COMBOBOX&TEXTBOX'DAKİ VERİLERİ AŞŞAĞI DOĞRU KAYDIRIR. Private Sub SpinButton2_Change() TextBox1.Value = ActiveCell.Offset(0, 0).Value ComboBox1.Value = ActiveCell.Offset(0, 1).Value TextBox3.Value = ActiveCell.Offset(0, 2).Value TextBox4.Value = ActiveCell.Offset(0, 3).Value TextBox5.Value = ActiveCell.Offset(0, 4).Value TextBox6.Value = ActiveCell.Offset(0, 5).Value ActiveCell.Offset(1, 0).Select 'BİRER BİRER HÜC.AŞŞAĞI KAYDIRIR. End Sub

veri olan hücreleri yazdırır

ID : 2412
ISLEM : veri olan hücreleri yazdırır
MAKRO KODU : Sub imprSansLigneVide() For Each Ligne In ActiveSheet.UsedRange.Rows If Ligne.Cells(1, 1).Value = Empty Then 'si la cellule de la colonne A est vide, la ligne est masquée Ligne.EntireRow.Hidden = True End If Next 'Recherche de la derniere cellule ActiveCell.SpecialCells(xlLastCell).Select dercell = ActiveCell.Address 'definition de la zone d'impression zoneIMP = Range("A1", dercell).Address ActiveSheet.PageSetup.PrintArea = zoneIMP ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub

veri olan iki ayrı sütunu birleştirme

ID : 2413
ISLEM : veri olan iki ayrı sütunu birleştirme
MAKRO KODU : Excel de iki ayrı sütuna girilen verileri bir sütün içine veri kaybı olmadan toplamak. 'Bir adet modul oluşturun ve içindeki kodları modeülün içine kopyalayın. Dim Sh_Src As String, Sh_Tgt As String Dim Sh_Src_Row As Integer, Sh_Src_Bas_Row As Integer, Sh_Src_Son_Row As Integer Sayfa = "sayfa1" Sh_Src_Bas_Row = 1 Sh_Src_Son_Row = 10 On Error GoTo Hata For Sh_Src_Row = Sh_Src_Bas_Row To Sh_Src_Son_Row If Trim(Sheets(Sayfa).Cells(Sh_Src_Row, "A")) = "" Then MsgBox "(Boş Veri)" & vbCrLf & "Hata Yeri!" & vbCrLf & "Sayfa Adı : " & Safya & vbCrLf & "Sütün Adı : A" & Sh_Tgt_Row & "", vbCritical, "Hata..." Exit Sub Else Selection.Cells(C).Value = Selection.Cells(A).Value & " " & Selection.Cells(B).Value End If Next MsgBox "Aktarım İşlemi Bitti!", vbInformation, "BİLGİ" Exit Sub Hata: MsgBox "Hata oluştu!" & vbCrLf & Err.Number & " : " & Err.Description, vbCritical, "HATA OLUŞTU!"

veri olan satırlardan yukarısını gizler

ID : 2414
ISLEM : veri olan satırlardan yukarısını gizler
MAKRO KODU : Sub HideRows() For Each rngRow In ActiveSheet.UsedRange.Rows If Application.Sum(rngRow) = 0 Then rngRow.EntireRow.Hidden = True End If Next rngRow End Sub

veri olan sayfaları yazdırma

ID : 2415
ISLEM : veri olan sayfaları yazdırma
MAKRO KODU : Sub verili_yaz() Dim wc As Integer For wc = 1 To ThisWorkbook.Worksheets.Count ThisWorkbook.Worksheets(wc).PrintOut Next wc End Sub

veri olan tüm sayfaları yazdırır yoksa tarar ama yazdırmaz

ID : 2416
ISLEM : veri olan tüm sayfaları yazdırır yoksa tarar ama yazdırmaz
MAKRO KODU : Option Explicit Sub PrintAllSheets() Dim First As Integer, Last As Integer '// Assumning Sheet1 is 1st sheet Sheets("Sheet1").Activate Last = Sheets.Count For First = 1 To Last With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" '// set up the way you want here, this is just an example! With ActiveSheet.PageSetup .CenterHeader = "&F!&A" .RightHeader = "" .LeftFooter = "" .CenterFooter = "Page " & First & " of " & Last .RightFooter = "©" & Application.Text(Now(), "yyyy") .PrintHeadings = False .PrintGridlines = False .PrintNotes = False .CenterHorizontally = True .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 End With ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True If First Last Then ActiveSheet.Next.Select Next First End Sub -

veri sıralar ve isim bulur

ID : 2417
ISLEM : veri sıralar ve isim bulur
MAKRO KODU : VERİLERİ A'DAN Z'YE SIRALAR YAZILAN İLKHARFE ENYAKIN İSMİ BULUR Private Sub ComboBox1_Change() 'ListFillRange A2:A64997(vba özellikler menüsüne girilecek hüc. Adreside buradan verilir.) ActiveWindow.ScrollRow = ComboBox1.ListIndex + 2 End Sub Private Sub ComboBox1_GotFocus() ActiveSheet.ComboBox1.ListIndex = -1 Rows("2:65000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim no no = ActiveWindow.ScrollRow If KeyCode = 13 Then Cells(no, 1).Activate End Sub

veri siler

ID : 2418
ISLEM : veri siler
MAKRO KODU : VERİLERİ SİLER Private Sub CommandButton7_Click() Dim say As Integer Dim i As Integer Dim bos As Range For Each bos In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000"))) If ComboBox1.Value = "" Or bos = "" Or ActiveCell = "" Then MsgBox "Önce aradığınız veriyi BUL ile bulmalısınız" Exit Sub End If Next bos Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 2).Address(False, False)).Delete Shift:=xlUp say = WorksheetFunction.CountA(Range("A2:A65000")) For i = 1 To say Cells(i + 1, 1) = i Next i Workbooks("kitap2.XLS").Save MsgBox "Veriniz Silindi", , "KAYIT" ComboBox1.RowSource = "Veri!B1:B" & say + 1 TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1 Unload UserForm1 UserForm1.Show End Sub

veri siler

ID : 2419
ISLEM : veri siler
MAKRO KODU : VERİLERİ SİLER Private Sub CommandButton7_Click() Dim say As Integer Dim i As Integer Dim bos As Range For Each bos In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000"))) If ComboBox1.Value = "" Or bos = "" Or ActiveCell = "" Then MsgBox "Önce aradığınız veriyi BUL ile bulmalısınız" Exit Sub End If Next bos Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 2).Address(False, False)).Delete Shift:=xlUp say = WorksheetFunction.CountA(Range("A2:A65000")) For i = 1 To say Cells(i + 1, 1) = i Next i Workbooks("kitap2.XLS").Save MsgBox "Veriniz Silindi", , "KAYIT" ComboBox1.RowSource = "Veri!B1:B" & say + 1 TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1 Unload UserForm1 UserForm1.Show End Sub

veri siralar ve isim bulur

ID : 2420
ISLEM : veri siralar ve isim bulur
MAKRO KODU : VERİLERİ A'DAN Z'YE SIRALAR YAZILAN İLKHARFE ENYAKIN İSMİ BULUR Private Sub ComboBox1_Change() 'ListFillRange A2:A64997(vba özellikler menüsüne girilecek hüc. Adreside buradan verilir.) ActiveWindow.ScrollRow = ComboBox1.ListIndex + 2 End Sub Private Sub ComboBox1_GotFocus() ActiveSheet.ComboBox1.ListIndex = -1 Rows("2:65000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim no no = ActiveWindow.ScrollRow If KeyCode = 13 Then Cells(no, 1).Activate End Sub

verilen degeri bul yanindakilari kopyala yapistir.

ID : 2421
ISLEM : verilen degeri bul yanindakilari kopyala yapistir.
MAKRO KODU : Sub ara() On Error Resume Next Application.ScreenUpdating = False sat = Sayfa1.Columns(1).Find(Sayfa2.[A1].Value).Row Sayfa1.Range("A" & sat, "F" & sat).Copy s = WorksheetFunction.CountA(Sayfa2.[B1:B65536]) Sayfa2.Range("B" & s + 1).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub

verilen değere göre farkli hücreye bilgi veren bir macro

ID : 2422
ISLEM : verilen değere göre farkli hücreye bilgi veren bir macro
MAKRO KODU : Sayfa1 Kod sayfasına;Kod: Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$a$1" Then Range("D54").Select End Sub Kodu yazdıktan sonra A1 Hücresine geldiğinizde D54 Hücresine gelecektir.Gerisini siz yaparsınız.Seçilen Hücreyi renk vermek istersenizKod: Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$F$10" Then Range("d54").Select Range("d54").Interior.ColorIndex = 6 End Sub Seçilen Hücreye Formul yazdırmak istersenizKod: Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$F$10" Then Range("d4").Select Range("d54").Formula = "=A1+A3" End Sub

verilen sayiyi gruplara bölme işlemi

ID : 2423
ISLEM : verilen sayiyi gruplara bölme işlemi
MAKRO KODU : Sub deneme() qc = WorksheetFunction.Ceiling([e5], 0.5) sat = 9 '*********** 3 kademe bol = 3: GoSub dagit '*********** 5 kademe bol = 5: GoSub dagit '*********** 7 kademe bol = 7: GoSub dagit '*********** 12 kademe bol = 12: GoSub dagit Exit Sub dagit: sat = sat + 1 st = WorksheetFunction.RoundUp(qc / bol, 0.5) par1 = qc - ((bol - 1) * st) par: If par1 -

verileri formülü bozmadan siler

ID : 2424
ISLEM : verileri formülü bozmadan siler
MAKRO KODU : KİTAPTAKİ VERİLERİ FORMÜLLERİ BOZMADAN SİLER Sub ResetModel() Range("A1").SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents End Sub

verileri formülü bozmadan siler

ID : 2425
ISLEM : verileri formülü bozmadan siler
MAKRO KODU : KİTAPTAKİ VERİLERİ FORMÜLLERİ BOZMADAN SİLER Sub ResetModel() Range("A1").SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents End Sub

verileri hücreye otomatik sığdırma

ID : 2426
ISLEM : verileri hücreye otomatik sığdırma
MAKRO KODU : Sub Optimale_Breite() Columns("A:IV").Select Range(Selection, Selection.End(xlToRight)).Select Cells.EntireColumn.AutoFit End Sub

verileri isim sırasına göre dizer

ID : 2427
ISLEM : verileri isim sırasına göre dizer
MAKRO KODU : FORMDAN COMBOBOX KUTUSUNA KOMUT BU KOMUT İSİMLERİ SIRAYA SOKAR MODÜLE YAZILAN KOMUT İLE BİRLİKTE. Private Sub UserForm_Initialize() MyForm = Me.Name ComboBox1.RowSource = "sayfa1!b1:b1000" OrganizeComboBox End Sub BU BÖLÜM MODÜL KISMINA YAZILACAK. Dim MyForm As Variant Option Base 1 ' Sub OrganizeComboBox() Dim noData, i, j, k, m As Integer Dim MyComboArray() Dim MyRevizedComboArray() Dim MyData As Range Dim SortedColl As New Collection Dim Swap1, Swap2 As Variant ' For Each MyControl In UserForms(MyForm).Controls ' i = 0 j = 0 k = 0 ' If TypeName(MyControl) = "ComboBox" Then noData = MyControl.ListCount ReDim MyComboArray(noData) For Each MyData In Range(MyControl.RowSource) i = i + 1 MyComboArray(i) = MyData Next For m = 1 To UBound(MyComboArray) If Not WorksheetFunction.IsNumber(MyComboArray(m)) Then MyComboArray(m) = UCase(MyComboArray(m)) MyComboArray(m) = Replace(MyComboArray(m), "Ç", "Ç") MyComboArray(m) = Replace(MyComboArray(m), "İ", "İ") MyComboArray(m) = Replace(MyComboArray(m), "Ğ", "Ğ") MyComboArray(m) = Replace(MyComboArray(m), "Ş", "Ş") MyComboArray(m) = Replace(MyComboArray(m), "Ü", "Ü") MyComboArray(m) = Replace(MyComboArray(m), "Ö", "Ö") End If Next For i = 1 To UBound(MyComboArray) For j = i + 1 To UBound(MyComboArray) - 1 If MyComboArray(i) = MyComboArray(j) Then MyComboArray(i) = "" End If Next Next ' MyControl.RowSource = "" ' For i = 1 To UBound(MyComboArray) If MyComboArray(i) "" Then k = k + 1 ReDim Preserve MyRevizedComboArray(k) MyRevizedComboArray(k) = MyComboArray(i) End If Next ' i = 0 j = 0 For i = 1 To UBound(MyRevizedComboArray) SortedColl.Add MyRevizedComboArray(i) Next ' 'On Error Resume Next 'For i = 1 To UBound(MyRevizedComboArray) 'MyRevizedComboArray(i) = WorksheetFunction.Small(MyRevizedComboArray, i) 'Next For i = 1 To SortedColl.Count - 1 For j = i + 1 To SortedColl.Count If SortedColl(i) > SortedColl(j) Then Swap1 = SortedColl(i) Swap2 = SortedColl(j) SortedColl.Add Swap1, before:=j SortedColl.Add Swap2, before:=i SortedColl.Remove i + 1 SortedColl.Remove j + 1 End If Next j Next i ' For i = 1 To SortedColl.Count MyControl.AddItem SortedColl(i) Next ' For i = SortedColl.Count To 1 Step -1 SortedColl.Remove i Next ' End If Erase MyComboArray Erase MyRevizedComboArray ' Next End Sub -

verileri isim sirasina göre dizer

ID : 2428
ISLEM : verileri isim sirasina göre dizer
MAKRO KODU : FORMDAN COMBOBOX KUTUSUNA KOMUT BU KOMUT İSİMLERİ SIRAYA SOKAR MODÜLE YAZILAN KOMUT İLE BİRLİKTE. Private Sub UserForm_Initialize() MyForm = Me.Name ComboBox1.RowSource = "sayfa1!b1:b1000" OrganizeComboBox End Sub BU BÖLÜM MODÜL KISMINA YAZILACAK. Dim MyForm As Variant Option Base 1 ' Sub OrganizeComboBox() Dim noData, i, j, k, m As Integer Dim MyComboArray() Dim MyRevizedComboArray() Dim MyData As Range Dim SortedColl As New Collection Dim Swap1, Swap2 As Variant ' For Each MyControl In UserForms(MyForm).Controls ' i = 0 j = 0 k = 0 ' If TypeName(MyControl) = "ComboBox" Then noData = MyControl.ListCount ReDim MyComboArray(noData) For Each MyData In Range(MyControl.RowSource) i = i + 1 MyComboArray(i) = MyData Next For m = 1 To UBound(MyComboArray) If Not WorksheetFunction.IsNumber(MyComboArray(m)) Then MyComboArray(m) = UCase(MyComboArray(m)) MyComboArray(m) = Replace(MyComboArray(m), "Ç", "Ç") MyComboArray(m) = Replace(MyComboArray(m), "İ", "İ") MyComboArray(m) = Replace(MyComboArray(m), "Ğ", "Ğ") MyComboArray(m) = Replace(MyComboArray(m), "Ş", "Ş") MyComboArray(m) = Replace(MyComboArray(m), "Ü", "Ü") MyComboArray(m) = Replace(MyComboArray(m), "Ö", "Ö") End If Next For i = 1 To UBound(MyComboArray) For j = i + 1 To UBound(MyComboArray) - 1 If MyComboArray(i) = MyComboArray(j) Then MyComboArray(i) = "" End If Next Next ' MyControl.RowSource = "" ' For i = 1 To UBound(MyComboArray) If MyComboArray(i) "" Then k = k + 1 ReDim Preserve MyRevizedComboArray(k) MyRevizedComboArray(k) = MyComboArray(i) End If Next ' i = 0 j = 0 For i = 1 To UBound(MyRevizedComboArray) SortedColl.Add MyRevizedComboArray(i) Next ' 'On Error Resume Next 'For i = 1 To UBound(MyRevizedComboArray) 'MyRevizedComboArray(i) = WorksheetFunction.Small(MyRevizedComboArray, i) 'Next For i = 1 To SortedColl.Count - 1 For j = i + 1 To SortedColl.Count If SortedColl(i) > SortedColl(j) Then Swap1 = SortedColl(i) Swap2 = SortedColl(j) SortedColl.Add Swap1, before:=j SortedColl.Add Swap2, before:=i SortedColl.Remove i + 1 SortedColl.Remove j + 1 End If Next j Next i ' For i = 1 To SortedColl.Count MyControl.AddItem SortedColl(i) Next ' For i = SortedColl.Count To 1 Step -1 SortedColl.Remove i Next ' End If Erase MyComboArray Erase MyRevizedComboArray ' Next End Sub -

verileri kaydeder

ID : 2429
ISLEM : verileri kaydeder
MAKRO KODU : VERİLERİ KAYDEDER Private Sub CommandButton5_Click() Dim bak As Range Dim say As Integer For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000"))) If bak.Value = ComboBox1.Value Then MsgBox "Bu Kayıt numarası bulundu." Exit Sub End If Next bak For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then MsgBox "Bu isimde bir kaydınız bulundu" Exit Sub End If Next bak say = WorksheetFunction.CountA(Range("B1:B65000")) TextBox1.Value = say Cells(say + 1, 1).Value = TextBox1.Value Cells(say + 1, 2).Value = ComboBox1.Value Cells(say + 1, 3).Value = TextBox2.Value Cells(say + 1, 4).Value = TextBox3.Value Workbooks("kitap2.XLS").Save MsgBox "Verileriniz Kaydedildi", , "KAYIT" ComboBox1.RowSource = "Veri!B2:B" & say + 1 TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1 Unload UserForm1 UserForm1.Show End Sub 'BU KOD FORMA YAZILIR Private Sub UserForm_Initialize() Dim say As Integer Sheets("Veri").Select TextBox1.Locked = True If Range("B2") = "" Then say = WorksheetFunction.CountA(Range("B1:B65000")) ComboBox1.RowSource = "Veri!B2:B" & say + 1 Else say = WorksheetFunction.CountA(Range("B1:B65000")) ComboBox1.RowSource = "Veri!B2:B" & say End If TextBox1.Value = say ComboBox1.SetFocus End Sub

verileri kaydeder

ID : 2430
ISLEM : verileri kaydeder
MAKRO KODU : VERİLERİ KAYDEDER Private Sub CommandButton5_Click() Dim bak As Range Dim say As Integer For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000"))) If bak.Value = ComboBox1.Value Then MsgBox "Bu Kayıt numarası bulundu." Exit Sub End If Next bak For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then MsgBox "Bu isimde bir kaydınız bulundu" Exit Sub End If Next bak say = WorksheetFunction.CountA(Range("B1:B65000")) TextBox1.Value = say Cells(say + 1, 1).Value = TextBox1.Value Cells(say + 1, 2).Value = ComboBox1.Value Cells(say + 1, 3).Value = TextBox2.Value Cells(say + 1, 4).Value = TextBox3.Value Workbooks("kitap2.XLS").Save MsgBox "Verileriniz Kaydedildi", , "KAYIT" ComboBox1.RowSource = "Veri!B2:B" & say + 1 TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1 Unload UserForm1 UserForm1.Show End Sub 'BU KOD FORMA YAZILIR Private Sub UserForm_Initialize() Dim say As Integer Sheets("Veri").Select TextBox1.Locked = True If Range("B2") = "" Then say = WorksheetFunction.CountA(Range("B1:B65000")) ComboBox1.RowSource = "Veri!B2:B" & say + 1 Else say = WorksheetFunction.CountA(Range("B1:B65000")) ComboBox1.RowSource = "Veri!B2:B" & say End If TextBox1.Value = say ComboBox1.SetFocus End Sub

* Görseller ve İçerik tekif hakkına sahip olabilir