Textbox içinde formüller ve makro kodları kısaltması

irfancantr · 29 Kasım 2011

Hocam kaydet butonu ile malum yeni veriler giriyorum ve boş textbox ve combobox ları ben manuel olarak tek tek dolduruyorum.

A sütununa numarayı kendisi veriyor.

düzelt butonu ise listbox tan seçtiğim satırı tüm comboboxlar ve textboxlara veriyi getirmesi üzerine, ben gerekli değişimleri textboxlardan yapıyorum ve düzelt butonuna basarak seçili satırda düzenleme gerçekleşiyor.

Listbox olayı ise ; listboxa tıkladığımda tüm veriler comboboxa ve textboxlarda gözükmesi. Değiştir butonu için tüm verilerin tüm textbox ve comboboxlara gelmesi gerekli.

Son olarak sayısal verilerin sayısal olarak kayıt edilmesi gerekiyor. Ben daha sonra sayısal bilgilerden formül ile bilgiler arıyorum.

İhsan Tank · 29 Kasım 2011

Benden istediğiniz bu uzun kodların hepsini döngüye almak mı_?
Yoksa kodları mı yazmalıyım sıfırdan

irfancantr · 29 Kasım 2011

İhsan Tank' Alıntı:
Benden istediğiniz bu uzun kodların hepsini döngüye almak mı_?
Yoksa kodları mı yazmalıyım sıfırdan

Hayır hocam sizden sıfırdan kod istemiyorum, en başından beri anlatmak istediğim;
Benim kodlarım bu şekildeydi ,

Kod:

Private Sub CommandButton1_Click()
Dim SATIR As Long
    If ComboBox1.Value = "" Or ComboBox2.Value = "" Or ComboBox3.Value = "" Then
        MsgBox "LÜTFEN BOŞ ALANLARI DOLDURUNUZ.", vbInformation
    Exit Sub

Else
Sheets("Veri").Select
SATIR = [b65536].End(3).Row + 1
    Cells(SATIR, "A") = SATIR - 2
    Cells(SATIR, "B") = ComboBox1.Value
    Cells(SATIR, "C") = ComboBox2.Value
    Cells(SATIR, "D") = ComboBox3.Value
    Cells(SATIR, "E") = ComboBox4.Value
    Cells(SATIR, "F") = ComboBox5.Value
    Cells(SATIR, "G") = ComboBox6.Value
    Cells(SATIR, "H") = ComboBox7.Value
'---------------------------------
    Cells(SATIR, "I") = TextBox1.Text
    Cells(SATIR, "J") = TextBox2.Text
    Cells(SATIR, "K") = TextBox3.Text
    Cells(SATIR, "L") = TextBox4.Text
    Cells(SATIR, "M") = TextBox5.Text
    Cells(SATIR, "N") = TextBox6.Text
    Cells(SATIR, "O") = TextBox7.Text
    Cells(SATIR, "P") = TextBox8.Text
    Cells(SATIR, "Q") = TextBox9.Value
    Cells(SATIR, "R") = TextBox10.Value
    Cells(SATIR, "S") = TextBox11.Value
    Cells(SATIR, "T") = TextBox12.Value
    Cells(SATIR, "U") = TextBox13.Value
    Cells(SATIR, "V") = TextBox14.Value
    Cells(SATIR, "W") = TextBox15.Value
    Cells(SATIR, "X") = TextBox16.Value
    Cells(SATIR, "Y") = TextBox17.Value
    Cells(SATIR, "Z") = TextBox18.Value
    Cells(SATIR, "AA") = TextBox19.Value
    Cells(SATIR, "AB") = TextBox20.Value
    Cells(SATIR, "AC") = TextBox21.Value
    Cells(SATIR, "AD") = TextBox22.Value
    Cells(SATIR, "AE") = TextBox23.Value
    Cells(SATIR, "AF") = TextBox24.Value
    Cells(SATIR, "AG") = TextBox25.Value
    Cells(SATIR, "AH") = TextBox26.Value
    Cells(SATIR, "AI") = TextBox27.Value
    Cells(SATIR, "AJ") = TextBox28.Value
    Cells(SATIR, "AK") = TextBox29.Value
    Cells(SATIR, "AL") = TextBox30.Value
    Cells(SATIR, "AM") = TextBox31.Value
    Cells(SATIR, "AN") = TextBox32.Value
    Cells(SATIR, "AO") = TextBox33.Value
    Cells(SATIR, "AP") = TextBox34.Value
    Cells(SATIR, "AQ") = TextBox35.Value
    Cells(SATIR, "AR") = TextBox36.Value
    Cells(SATIR, "AS") = TextBox37.Value
    Cells(SATIR, "AT") = TextBox38.Value
    Cells(SATIR, "AU") = TextBox39.Value
    Cells(SATIR, "AV") = TextBox40.Value
    Cells(SATIR, "AW") = TextBox41.Value
    Cells(SATIR, "AX") = TextBox42.Value
    Cells(SATIR, "AY") = TextBox43.Value
    Cells(SATIR, "AZ") = TextBox44.Value
    Cells(SATIR, "BA") = TextBox45.Value
    Cells(SATIR, "BB") = TextBox46.Value
    Cells(SATIR, "BC") = TextBox47.Value
    Cells(SATIR, "BD") = TextBox48.Value
    Cells(SATIR, "BE") = TextBox49.Value
    Cells(SATIR, "BF") = TextBox50.Value
    Cells(SATIR, "BG") = TextBox51.Value
    Cells(SATIR, "BH") = TextBox52.Value
    Cells(SATIR, "BI") = TextBox53.Value
    Cells(SATIR, "BJ") = TextBox54.Value
    Cells(SATIR, "BK") = TextBox55.Value
    Cells(SATIR, "BL") = TextBox56.Value
    Cells(SATIR, "BM") = TextBox57.Value
    Cells(SATIR, "BN") = TextBox58.Value
    Cells(SATIR, "BO") = TextBox59.Value
    Cells(SATIR, "BP") = TextBox60.Value
    Cells(SATIR, "BW") = TextBox67.Value
    Cells(SATIR, "BX") = TextBox68.Value
    Cells(SATIR, "BY") = TextBox69.Value
    Cells(SATIR, "CB") = TextBox200.Value
End If

    MsgBox " İşlem Tamamdır...", vbOKOnly
    Unload Me
TextBox99 = ".": TextBox99 = ""
End Sub

Ve ben sizin bana hazırladığınız kodlar yardımı ile bu uzun uzun kodlarımı bu şekilde kısaltabildim,

Kod:

Private Sub CommandButton1_Click()
Dim ts, kaplan, SATIR
    SATIR = Range("A" & Rows.Count).End(xlUp).Row + 1
    For ts = 1 To 7
    If Controls("ComboBox" & ts) = Empty Then
        MsgBox "ComboBox" & ts & " Boş"
        Controls("ComboBox" & ts).SetFocus
    Exit Sub
    End If
    Next
kaplan = 2
For ts = 1 To 7
    Cells(SATIR, kaplan) = Controls("ComboBox" & ts)
    kaplan = kaplan + 1
Next
kaplan = 9
For ts = 1 To 72
    Cells(SATIR, kaplan) = Controls("Textbox" & ts)
    kaplan = kaplan + 1
Next
    MsgBox " İşlem Tamamdır...", vbOKOnly
    Unload Me
TextBox99 = ".": TextBox99 = ""
End Sub

Bu şekilde ListBox1_Click() ve CommandButton2_Click() kodlarımda ki uzun kodları kısaltabilmekti.

Ama bu işlemi yaparken en büyük sıkıntımın sayısal değerlerin metin olarak hücrelere kayıt olmasıydı.Ayrıca A sütununa sıra verme kodu eksikliği.

Umarım bu sefer anlatabilmişimdir.

İhsan Tank · 29 Kasım 2011

Yalnız siz yanlış bilgileri çekiyorsunuz bundan dolayı makro hatalı bilgileri hatalı yerlere kayıt yapıyor bilginiz olsun.

irfancantr · 29 Kasım 2011

Ne gibi hocam? Daha doğru sormak gerekirse nasıl düzeltebilirim?

İhsan Tank · 29 Kasım 2011

irfancantr' Alıntı:
Ne gibi hocam? Daha doğru sormak gerekirse nasıl düzeltebilirim?

Merhaba
Listbox'un kodunu bununla değiştirin.

Kod:

Private Sub ListBox1_Click()
Dim sat, kaplan, ts
On Error Resume Next
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "A") = ListBox1.Column(0) * 1 Then
kaplan = 2
For ts = 1 To 5
Controls("ComboBox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
Next
kaplan = 7
For ts = 1 To 5
If ts = 3 Then
Controls("Textbox" & ts) = Format(Cells(sat, kaplan), "dd.mm.yyyy")
kaplan = kaplan + 1
ElseIf ts = 4 Or ts = 5 Then
Controls("Textbox" & ts) = Format(Cells(sat, kaplan), "#,##0.00")
kaplan = kaplan + 1
Else
Controls("Textbox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
End If
Next
End If
Next
End Sub

Not : Sizin eklediğiniz kodlar bazı bilgilerin çıkmasını engelliyor o kodları pasif hale gitirip denedim gayet başarılı bir sonuç elde ettim.

irfancantr · 29 Kasım 2011

İhsan Tank' Alıntı:
Merhaba
Listbox'un kodunu bununla değiştirin.
Not : Sizin eklediğiniz kodlar bazı bilgilerin çıkmasını engelliyor o kodları pasif hale gitirip denedim gayet başarılı bir sonuç elde ettim.

Teşekkürler İhsan hocam, Peki kaydet ve düzelt butonlarını bu şekilde sorunsuz düzenleyebilir miyiz?

Çok oluyorum farkındayım, hakkınızı helal edin şimdiden.

İhsan Tank · 29 Kasım 2011

Merhaba
Değiştir butonunun kodunu bununla değiştirin.

Kod:

Private Sub CommandButton2_Click()
Dim sat, kaplan, ts
'*****listbox seçili değilse uyar
If ListBox1.ListIndex < 0 Then
MsgBox "Önce bir isim seçmelisiniz", vbInformation
Exit Sub: End If
'*****değişecek verileri döngü ile kontrol et
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "a") = ListBox1.Column(0) * 1 Then
kaplan = 2
For ts = 1 To 5
Cells(sat, kaplan) = Controls("ComboBox" & ts)
kaplan = kaplan + 1
Next
kaplan = 7
For ts = 1 To 5
If ts = 3 Then
Cells(sat, kaplan) = CDate(Controls("Textbox" & ts))
kaplan = kaplan + 1
ElseIf ts = 4 Or ts = 5 Then
Cells(sat, kaplan) = CDbl(Controls("Textbox" & ts))
kaplan = kaplan + 1
Else
Cells(sat, kaplan) = CDbl(Controls("Textbox" & ts))
kaplan = kaplan + 1
End If
Next
End If
Next
'***** listboxu yenile
TextBox99 = ".": TextBox99 = ""
MsgBox " İşlem Tamamdır...", vbOKOnly
Unload Me
End Sub

İhsan Tank · 29 Kasım 2011

Kaydet butonundaki kodu bununla değiştirin.

Kod:

Private Sub CommandButton1_Click()
Dim ts, kaplan, SATIR
SATIR = Range("A" & Rows.Count).End(xlUp).Row + 1
For ts = 1 To 5
If Controls("ComboBox" & ts) = Empty Then
MsgBox "ComboBox" & ts & " Boş"
Controls("ComboBox" & ts).SetFocus
Exit Sub
End If
Next
kaplan = 2
For ts = 1 To 5
Cells(SATIR, kaplan) = Controls("ComboBox" & ts)
kaplan = kaplan + 1
Next
kaplan = 7
For ts = 1 To 5
If ts = 3 Then
Cells(sat, kaplan) = CDate(Controls("Textbox" & ts))
kaplan = kaplan + 1
ElseIf ts = 4 Or ts = 5 Then
Cells(sat, kaplan) = CDbl(Controls("Textbox" & ts))
kaplan = kaplan + 1
Else
Cells(sat, kaplan) = CDbl(Controls("Textbox" & ts))
kaplan = kaplan + 1
End If
Next
MsgBox " İşlem Tamamdır...", vbOKOnly
Unload Me
TextBox99 = ".": TextBox99 = ""
ts = Range("B" & Rows.Count).End(xlUp).Row
Range("A3") = 1
Range("A3:A" & ts).DataSeries rowcol:=xlColumn, Type:=xlLinear, Date:=xlDay, step:=1, Trend:=False
End Sub

irfancantr · 29 Kasım 2011

Çok teşekkür ederim İhsan hocam. İlave kod olarak kaydet butonuna, A sütunu için kendisi numara verebilir mi?

İhsan Tank · 29 Kasım 2011

irfancantr' Alıntı:
Çok teşekkür ederim İhsan hocam. İlave kod olarak kaydet butonuna, A sütunu için kendisi numara verebilir mi?

Üstteki kaydet butonu kodunu güncelledim inceleyin.

irfancantr · 29 Kasım 2011

Hocam kodlarda ki bu satır da hata gösterdi;

Range("A3:A" & ts).DataSeries rowcol:=xlColumn, Type:=xlLinear, Date:=xlDay, step:=1, Trend:=False

İhsan Tank · 29 Kasım 2011

irfancantr' Alıntı:
Hocam kodlarda ki bu satır da hata gösterdi;

Bende hata vermedi ben denedim.
Hata aldığınız dosyayı ekler misiniz_?

irfancantr · 29 Kasım 2011

İhsan Tank' Alıntı:
Bende hata vermedi ben denedim.
Hata aldığınız dosyayı ekler misiniz_?

Buyurun hocam.

İhsan Tank · 29 Kasım 2011

irfancantr' Alıntı:
Buyurun hocam.

Merhaba

Kod:

Range("A3:A" & ts).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, step:=1, Trend:=False

Bununla değiştirir misiniz_?

irfancantr · 29 Kasım 2011

İhsan Tank' Alıntı:
Merhaba

Kod:

Range("A3:A" & ts).DataSeries rowcol:=xlColumn[COLOR="Red"][B]s[/B][/COLOR], ....

Bununla değiştirir misiniz_?

Sağolun İhsan hocam, s harfi bende neden hata verdi anlamadım

Hocam sizin 26. mesajınızda bulunan Listbox için hazırladığınız kodun içerisinde ki format ile ilgili kodlar bulunmak zorunda mı?

Kod:

Private Sub ListBox1_Click()
Dim sat, kaplan, ts
On Error Resume Next
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "A") = ListBox1.Column(0) * 1 Then
kaplan = 2
For ts = 1 To 5
Controls("ComboBox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
Next
kaplan = 7
For ts = 1 To 5
[B][COLOR="Red"]If ts = 3 Then
Controls("Textbox" & ts) = Format(Cells(sat, kaplan), "dd.mm.yyyy")
kaplan = kaplan + 1
ElseIf ts = 4 Or ts = 5 Then
Controls("Textbox" & ts) = Format(Cells(sat, kaplan), "#,##0.00")
kaplan = kaplan + 1
Else[/COLOR][/B]
Controls("Textbox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
End If
Next
End If
Next
End Sub

Bu bölümü istememe gibi bir şansımız var mı? Yoksa, "kullan gitsin işte o kadar uğraştırma beni yeter artık" mı?

İhsan Tank · 29 Kasım 2011

irfancantr' Alıntı:
Sağolun İhsan hocam, s harfi bende neden hata verdi anlamadım

Hocam sizin 26. mesajınızda bulunan Listbox için hazırladığınız kodun içerisinde ki format ile ilgili kodlar bulunmak zorunda mı?

Kod:

Private Sub ListBox1_Click() Dim sat, kaplan, ts On Error Resume Next For sat = 2 To Cells(65536, "b").End(xlUp).Row If Cells(sat, "A") = ListBox1.Column(0) * 1 Then kaplan = 2 For ts = 1 To 5 Controls("ComboBox" & ts) = Cells(sat, kaplan) kaplan = kaplan + 1 Next kaplan = 7 For ts = 1 To 5 [B][COLOR="Red"]If ts = 3 Then Controls("Textbox" & ts) = [COLOR="red"]Format([/COLOR]Cells(sat, kaplan)[COLOR="red"], "dd.mm.yyyy")[/COLOR] kaplan = kaplan + 1 ElseIf ts = 4 Or ts = 5 Then Controls("Textbox" & ts) = [COLOR="Red"]Format([/COLOR]Cells(sat, kaplan)[COLOR="red"], "#,##0.00")[/COLOR] kaplan = kaplan + 1 Else[/COLOR][/B] Controls("Textbox" & ts) = Cells(sat, kaplan) kaplan = kaplan + 1 End If Next End If Next End Sub

Bu bölümü istememe gibi bir şansımız var mı? Yoksa, "kullan gitsin işte o kadar uğraştırma beni yeter artık" mı?

Merhaba
Kırmızı olan yerleri silebilirsiniz.
S harfi normalde bendede hata vermişti kopya alırken yanlış almışım ondan size yanlış kod gelmiş. Biraz yoğunluk vardı ondan işler karıştı acele yardım edeyim derken yanlış yazmışım.

irfancantr · 29 Kasım 2011

İhsan Tank' Alıntı:
Merhaba
Kırmızı olan yerleri silebilirsiniz.
S harfi normalde bendede hata vermişti kopya alırken yanlış almışım ondan size yanlış kod gelmiş. Biraz yoğunluk vardı ondan işler karıştı acele yardım edeyim derken yanlış yazmışım.

İşlerinizde ALLAH kolaylık versin.

Kod:

Private Sub ListBox1_Click()
Dim sat, kaplan, ts
On Error Resume Next
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "A") = ListBox1.Column(0) * 1 Then
kaplan = 2
For ts = 1 To 5
Controls("ComboBox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
Next
kaplan = 7
For ts = 1 To 5
[B][COLOR="Red"]If ts = 3 Then
Controls("Textbox" & ts) = Format(Cells(sat, kaplan), "dd.mm.yyyy")
kaplan = kaplan + 1
ElseIf ts = 4 Or ts = 5 Then
Controls("Textbox" & ts) = Format(Cells(sat, kaplan), "#,##0.00")
kaplan = kaplan + 1
Else[/COLOR][/B]
Controls("Textbox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
[B][COLOR="red"]End If
Next
End If[/COLOR][/B]
Next
End Sub

Kırmızı kodları sildiğimde başlıkta hata veriyor.
Hata olarakta kodun bitişi olan "End Sub" olarak gösteriyor.

İhsan Tank · 29 Kasım 2011

irfancantr' Alıntı:

İşlerinizde ALLAH kolaylık versin.

Kod:

Private Sub ListBox1_Click()
Dim sat, kaplan, ts
On Error Resume Next
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "A") = ListBox1.Column(0) * 1 Then
kaplan = 2
For ts = 1 To 5
Controls("ComboBox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
Next
kaplan = 7
For ts = 1 To 5
[B][COLOR="Red"]If ts = 3 Then
Controls("Textbox" & ts) = [COLOR="Blue"]Format([/COLOR]Cells(sat, kaplan)[COLOR="blue"], "dd.mm.yyyy")[/COLOR]
kaplan = kaplan + 1
ElseIf ts = 4 Or ts = 5 Then
Controls("Textbox" & ts) = [COLOR="blue"]Format([/COLOR]Cells(sat, kaplan)[COLOR="blue"], "#,##0.00")[/COLOR]
kaplan = kaplan + 1
Else[/COLOR][/B]
Controls("Textbox" & ts) = Cells(sat, kaplan)
kaplan = kaplan + 1
[B][COLOR="red"]End If
Next
End If[/COLOR][/B]
Next
End Sub

Kırmızı kodları sildiğimde başlıkta hata veriyor.
Hata olarakta kodun bitişi olan "End Sub" olarak gösteriyor.

Merhaba
kusura bakmayın sizde kırmızıya boyamışsınız bende kırmızıya boyadım yanlışlıkla şimdi maviye boyadım

irfancantr · 29 Kasım 2011

İhsan Tank' Alıntı:
Merhaba
kusura bakmayın sizde kırmızıya boyamışsınız bende kırmızıya boyadım yanlışlıkla şimdi maviye boyadım

Evet onları daha önceden silip denemiştim, belkide daha farklı yolu olabilir mi diye düşünmüştüm.

Başınızı ağrıttım yardımlarınız için tekrardan teşekkür ederim, kolay gelsin iyi akşamlar.

Textbox içinde formüller ve makro kodları kısaltması

irfancantr

Ekli dosyalar

İhsan Tank

Misafir

irfancantr

İhsan Tank

Misafir

irfancantr

İhsan Tank

Misafir

irfancantr

İhsan Tank

Misafir

İhsan Tank

Misafir

irfancantr

İhsan Tank

Misafir

irfancantr

İhsan Tank

Misafir

irfancantr

Ekli dosyalar

İhsan Tank

Misafir

irfancantr

İhsan Tank

Misafir

irfancantr

İhsan Tank

Misafir

irfancantr