• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

userform dan excele veri getirmek

  • Konbuyu başlatan Konbuyu başlatan macay
  • Başlangıç tarihi Başlangıç tarihi
M

macay

Katılım
27 Ekim 2006
Mesajlar
119
Excel Vers. ve Dili
excel 2007-Türkçe
Sayın Üstadlar, Userform da alt alta 20 tane combobox var, ve kayıt et düğmesine bastığım zaman bunların ilgili excel sayfasına alt alta kayıt olması gerekiyor aşağıdaki şekle getirdim fakat sadece userform içindeki son satırı dikkate alıyor, ve sadece onu excele aktarıyor yardım edermisiniz.

saygılarımla

Kod: 
For i = 1 To 20

With sayfa
If Me.Controls("CboBcins" & i) = "" Then
Controls("CboBcins" & i) = ""

Else
.Cells(satir, 1).Value = Me.Controls("TxtRec").Value  'ilk satıra yazılacak veriler
.Cells(satir, 2).Value = Me.TxtTarih.Value  'ilk satıra yazılacak veriler
.Cells(satir, 3).Value = Me.TxtVardya.Value  'ilk satıra yazılacak veriler
.Cells(satir, 4).Value = Me.Txtblm.Value  'ilk satıra yazılacak veriler
.Cells(satir, 5).Value = Me.CboPer.Value  'ilk satıra yazılacak veriler
.Cells(satir, 6).Value = Me.Controls("CboMakNo" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 7).Value = Me.Controls("TxtUsk" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 8).Value = Me.Controls("CboBcins" & i).Value '("HarUrn" & i)  'ilk satıra yazılacak veriler
.Cells(satir, 9).Value = Me.Controls("TxtBrm" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 10).Value = Me.Controls("TxtBobMik" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 13).Value = Me.Controls("Txtaciklama" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 14).Value = Me.Controls("TxtCalSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 15).Value = Me.Controls("TxtStopSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir + 1, 1).Value = Me.TxtRec.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 2).Value = Me.TxtTarih.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 3).Value = Me.TxtVardya.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 4).Value = Me.Txtblm.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 5).Value = Me.CboPer.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 6).Value = Me.Controls("CboMakNo" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 7).Value = Me.Controls("txtFireSk" & i) 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 8).Value = "HURDA - GRANÜL" 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 10).Value = Me.Controls("TxtFire" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 2, 1).Value = Me.TxtRec.Value
.Cells(satir + 2, 2).Value = Me.TxtTarih.Value
.Cells(satir + 2, 3).Value = Me.TxtVardya.Value
.Cells(satir + 2, 4).Value = Me.Txtblm.Value
.Cells(satir + 2, 5).Value = Me.CboPer.Value
.Cells(satir + 2, 6).Value = Me.Controls("CboMakNo" & i).Value
.Cells(satir + 2, 7).Value = Me.Controls("TxtYsk" & i).Value
.Cells(satir + 2, 8).Value = Me.Controls("CboKulKar" & i).Value
.Cells(satir + 2, 11).Value = Me.Controls("TxtKarMik" & i).Value
End If
End With
Next i
 
Alt alta derken ?
Sadece 20 combodaki verileri 1 de 20 ye kadar mı ?
Yoksa 1 den 65536 ya kadarmı ?
Yani combolara veri girdiğinde kaydet dediğin zaman önceki kaydın üzerine mi kaydedecek
Yoksa 21. satırdan tekrar yeni verilerimi kaydedecek...
 
İlgilendiğiniz için teşekkür ederim mustafa bey, son kayıt edilen satırın altına devam edecek, herbir combobox verisi 3 satır altalta kayıt oluyor
 
Mustafa bey, Tüm Kod aşağıdaki şekilde
Kod: 
Private Sub Combut1_Click() 'kaydet butonuna bağlı gelişen olaylar
Dim satir As Long
Dim sayfa As Worksheet
Set sayfa = Worksheets("kayıtlar")
satir = sayfa.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'Verileri sayfaya yaz

For i = 1 To 20

With sayfa
If Me.Controls("CboBcins" & i) = "" Then
Controls("CboBcins" & i) = ""

Else
.Cells(satir, 1).Value = Me.Controls("TxtRec").Value  'ilk satıra yazılacak veriler
.Cells(satir, 2).Value = Me.TxtTarih.Value  'ilk satıra yazılacak veriler
.Cells(satir, 3).Value = Me.TxtVardya.Value  'ilk satıra yazılacak veriler
.Cells(satir, 4).Value = Me.Txtblm.Value  'ilk satıra yazılacak veriler
.Cells(satir, 5).Value = Me.CboPer.Value  'ilk satıra yazılacak veriler
.Cells(satir, 6).Value = Me.Controls("CboMakNo" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 7).Value = Me.Controls("TxtUsk" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 8).Value = Me.Controls("CboBcins" & i).Value '("HarUrn" & i)  'ilk satıra yazılacak veriler
.Cells(satir, 9).Value = Me.Controls("TxtBrm" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 10).Value = Me.Controls("TxtBobMik" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 13).Value = Me.Controls("Txtaciklama" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 14).Value = Me.Controls("TxtCalSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 15).Value = Me.Controls("TxtStopSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir + 1, 1).Value = Me.TxtRec.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 2).Value = Me.TxtTarih.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 3).Value = Me.TxtVardya.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 4).Value = Me.Txtblm.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 5).Value = Me.CboPer.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 6).Value = Me.Controls("CboMakNo" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 7).Value = Me.Controls("txtFireSk" & i) 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 8).Value = "HURDA - GRANÜL" 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 10).Value = Me.Controls("TxtFire" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 2, 1).Value = Me.TxtRec.Value
.Cells(satir + 2, 2).Value = Me.TxtTarih.Value
.Cells(satir + 2, 3).Value = Me.TxtVardya.Value
.Cells(satir + 2, 4).Value = Me.Txtblm.Value
.Cells(satir + 2, 5).Value = Me.CboPer.Value
.Cells(satir + 2, 6).Value = Me.Controls("CboMakNo" & i).Value
.Cells(satir + 2, 7).Value = Me.Controls("TxtYsk" & i).Value
.Cells(satir + 2, 8).Value = Me.Controls("CboKulKar" & i).Value
.Cells(satir + 2, 11).Value = Me.Controls("TxtKarMik" & i).Value
End If
End With
Next i
 
satir = sayfa.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Yukarıdaki kodu
satir = Sheets("kayıtlar").Range("A65536").End(3).Row + 1
Bu şekilde değiştirdiğinizde sorun çözülüyor mu ?..
 
Mustafa Hocam, Yukarıdaki şekilde olmadı,Ben son dolu satırı buldurduktan sonra aşağıdaki şekilde atıyordum excele, yani herbir combox bilgileri için aşağıdaki kodu yazıp kaydet deyine satırları tek tek geçip kayıtları excele atıyor, bu şekilde herbir combox için yazarsam çalışıyor benim istediğim döngü ile halledip programı kasmamak

Kod: 
'If CboBcins2 = "" Then
'CboBcins2 = ""
'Else
'.Cells(satir + 3, 1).Value = Me.TxtRec.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 2).Value = Me.TxtTarih.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 3).Value = Me.TxtVardya.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 4).Value = Me.Txtblm.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 5).Value = Me.CboPer.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 6).Value = Me.CboMakNo2.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 7).Value = Me.TxtUsk2.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 8).Value = Me.CboBcins2.List(HarUrn2) 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 9).Value = Me.TxtBrm2.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 10).Value = Me.TxtBobMik2.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 13).Value = Me.Txtaciklama2.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 14).Value = Me.TxtCalSure2.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 3, 15).Value = Me.TxtStopSure2.Value 'ilk satıra yazılacak veriler
'.Cells(satir + 4, 1).Value = Me.TxtRec.Value 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 2).Value = Me.TxtTarih.Value 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 3).Value = Me.TxtVardya.Value 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 4).Value = Me.Txtblm.Value 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 5).Value = Me.CboPer.Value 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 6).Value = Me.CboMakNo2.Value 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 7).Value = Me.txtFireSk2 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 8).Value = "HURDA - GRANÜL" 'sonraki satırlara yazılacak veriler
'.Cells(satir + 4, 10).Value = Me.TxtFire2.Value 'sonraki satırlara yazılacak veriler
'.Cells(satir + 5, 1).Value = Me.TxtRec.Value
'.Cells(satir + 5, 2).Value = Me.TxtTarih.Value
'.Cells(satir + 5, 3).Value = Me.TxtVardya.Value
'.Cells(satir + 5, 4).Value = Me.Txtblm.Value
'.Cells(satir + 5, 5).Value = Me.CboPer.Value
'.Cells(satir + 5, 6).Value = Me.CboMakNo2.Value
'.Cells(satir + 5, 7).Value = Me.TxtYsk2.Value
'.Cells(satir + 5, 8).Value = Me.CboKulKar2.List(Harkar2)
'.Cells(satir + 5, 11).Value = Me.TxtKarMik2.Value
'End If
 
Dosya eklersen belki ne demek istediğini daha iyi anlarız..
 
2003 kullanıyorum.
2003 olarak eklersen akşam bakabilirim.
 
Kardeşim Dosyana baktım.
İncelenmesi lazım.
Uzun zaman alır
Çalışmayı sen hazırladığın için sonuca sen daha çabuk ulaşırsın.
Şu kodu kendine göre uyarla

Private Sub CommandButton1_Click()
Dim satir
satir = Sheets("kayıtlar").Range("A65536").End(3).Row + 1
Sheets("kayıtlar").Cells(satir, "A") = TextBox1.Text
Sheets("kayıtlar").Cells(satir, "B") = TextBox2.Text
Sheets("kayıtlar").Cells(satir, "C") = TextBox3.Text
Sheets("kayıtlar").Cells(satir, "D") = TextBox4.Text
satir = Sheets("kayıtlar").Range("A65536").End(3).Row + 1
Sheets("kayıtlar").Cells(satir, "A") = TextBox5.Text
Sheets("kayıtlar").Cells(satir, "B") = TextBox6.Text
Sheets("kayıtlar").Cells(satir, "C") = TextBox7.Text
Sheets("kayıtlar").Cells(satir, "D") = TextBox8.Text
End Sub

Buradaki TextBox ları kendi verdiğin isimlere göre ayarla
Combo yada text neyse artık
Kaydedeceği Sütun harfine göre ayarlaman lazım.
Bu 8 textli bir kod.
ilk 4 ü 1. satıra 2. 4 ü ise 2. satıra kaydeder.
sen bunu 20 - 30 hatta 50 ye çıkarabilirsin.
Bir kendine göre uyarlamaya çalış bakalım nasıl olacak.
 
Syn. Macay;

Aşağdaki koda maviyle yazdığım satırı ekledim.
Örnek dosyayı incelermisiniz.
Kod: 
For i = 1 To 20

With sayfa
If Me.Controls("CboBcins" & i) = "" Then
Controls("CboBcins" & i) = ""

Else
.Cells(satir, 1).Value = Me.TxtRec.Value 'ilk satıra yazılacak veriler
.Cells(satir, 2).Value = Me.TxtTarih.Value  'ilk satıra yazılacak veriler
.Cells(satir, 3).Value = Me.TxtVardya.Value  'ilk satıra yazılacak veriler
.Cells(satir, 4).Value = Me.Txtblm.Value  'ilk satıra yazılacak veriler
.Cells(satir, 5).Value = Me.CboPer.Value  'ilk satıra yazılacak veriler
.Cells(satir, 6).Value = Me.Controls("CboMakNo" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 7).Value = Me.Controls("TxtUsk" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 8).Value = Me.Controls("CboBcins" & i).Value '("HarUrn" & i)  'ilk satıra yazılacak veriler
.Cells(satir, 9).Value = Me.Controls("TxtBrm" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 10).Value = Me.Controls("TxtBobMik" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 13).Value = Me.Controls("Txtaciklama" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 14).Value = Me.Controls("TxtCalSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 15).Value = Me.Controls("TxtStopSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir + 1, 1).Value = Me.TxtRec.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 2).Value = Me.TxtTarih.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 3).Value = Me.TxtVardya.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 4).Value = Me.Txtblm.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 5).Value = Me.CboPer.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 6).Value = Me.Controls("CboMakNo" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 7).Value = Me.Controls("txtFireSk" & i) 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 8).Value = "HURDA - GRANÜL" 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 10).Value = Me.Controls("TxtFire" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 2, 1).Value = Me.TxtRec.Value
.Cells(satir + 2, 2).Value = Me.TxtTarih.Value
.Cells(satir + 2, 3).Value = Me.TxtVardya.Value
.Cells(satir + 2, 4).Value = Me.Txtblm.Value
.Cells(satir + 2, 5).Value = Me.CboPer.Value
.Cells(satir + 2, 6).Value = Me.Controls("CboMakNo" & i).Value
.Cells(satir + 2, 7).Value = Me.Controls("TxtYsk" & i).Value
.Cells(satir + 2, 8).Value = Me.Controls("CboKulKar" & i).Value
.Cells(satir + 2, 11).Value = Me.Controls("TxtKarMik" & i).Value

[COLOR="Blue"]satir = satir + 3[/COLOR]

End If
End With
Next i
 

Ekli dosyalar

Syn. Macay;

Aşağdaki koda maviyle yazdığım satırı ekledim.
Ayrıca dosyanızdaki kodların son satırlarınıda sadeleştirdim.
Örnek dosyayı incelermisiniz.
Kod: 
For i = 1 To 20

With sayfa
If Me.Controls("CboBcins" & i) = "" Then
Controls("CboBcins" & i) = ""

Else
.Cells(satir, 1).Value = Me.TxtRec.Value 'ilk satıra yazılacak veriler
.Cells(satir, 2).Value = Me.TxtTarih.Value  'ilk satıra yazılacak veriler
.Cells(satir, 3).Value = Me.TxtVardya.Value  'ilk satıra yazılacak veriler
.Cells(satir, 4).Value = Me.Txtblm.Value  'ilk satıra yazılacak veriler
.Cells(satir, 5).Value = Me.CboPer.Value  'ilk satıra yazılacak veriler
.Cells(satir, 6).Value = Me.Controls("CboMakNo" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 7).Value = Me.Controls("TxtUsk" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 8).Value = Me.Controls("CboBcins" & i).Value '("HarUrn" & i)  'ilk satıra yazılacak veriler
.Cells(satir, 9).Value = Me.Controls("TxtBrm" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 10).Value = Me.Controls("TxtBobMik" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 13).Value = Me.Controls("Txtaciklama" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 14).Value = Me.Controls("TxtCalSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir, 15).Value = Me.Controls("TxtStopSure" & i).Value 'ilk satıra yazılacak veriler
.Cells(satir + 1, 1).Value = Me.TxtRec.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 2).Value = Me.TxtTarih.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 3).Value = Me.TxtVardya.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 4).Value = Me.Txtblm.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 5).Value = Me.CboPer.Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 6).Value = Me.Controls("CboMakNo" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 7).Value = Me.Controls("txtFireSk" & i) 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 8).Value = "HURDA - GRANÜL" 'sonraki satırlara yazılacak veriler
.Cells(satir + 1, 10).Value = Me.Controls("TxtFire" & i).Value 'sonraki satırlara yazılacak veriler
.Cells(satir + 2, 1).Value = Me.TxtRec.Value
.Cells(satir + 2, 2).Value = Me.TxtTarih.Value
.Cells(satir + 2, 3).Value = Me.TxtVardya.Value
.Cells(satir + 2, 4).Value = Me.Txtblm.Value
.Cells(satir + 2, 5).Value = Me.CboPer.Value
.Cells(satir + 2, 6).Value = Me.Controls("CboMakNo" & i).Value
.Cells(satir + 2, 7).Value = Me.Controls("TxtYsk" & i).Value
.Cells(satir + 2, 8).Value = Me.Controls("CboKulKar" & i).Value
.Cells(satir + 2, 11).Value = Me.Controls("TxtKarMik" & i).Value

[COLOR="Blue"]satir = satir + 3[/COLOR]

End If
End With
Next i
 

Ekli dosyalar

Sayın ynmCany, İlginize Çok Teşekkür ederim sayenizde benim için büyük bir problem giderildi, sağolun hatasız çalışıyor.

Saygılarımla,
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst