Sıralı şekilde seri oluşturmak.

[Korhan Ayhan]

Selam arkadaşlar;

Userform üzerinde oluşturduğum textboxlara başlangıç ve bitiş değerleri girip girdiğim değer aralığını excelde "Zimmet" sayfasında B sütununda başlangıç ve bitiş değerleri dahil seri oluşturmak istiyorum.Tabi bu seriyi oluştururken mükerrer kayıt kontrolüde yaptırmak istiyorum.

Ã?rnek verecek olursam;

Textbox1 = 425850
Textbox2 = 425900
Textbox3 = Zimmet Tarihi
Textbox4 = Zimmetlenen Kişi

Yukarıda verdiğim değerleri girdiğimde,

1-425850 01-01-2005 Kemal KESKİN
2-425851 01-01-2005 Kemal KESKİN
3-425853 01-01-2005 Kemal KESKİN
.....

seri bitene kadar devam edecek şekilde seri üretmek istiyorum.

İyi çalışmalar dilerim.

 

[Korhan Ayhan]

Pardon arkadaşlar,

Aşağıdaki seride

1-425850 01-01-2005 Kemal KESKİN
2-425851 01-01-2005 Kemal KESKİN
3-425852 01-01-2005 Kemal KESKİN (Arada bu kısmı atlamışım.) :kafa:
4-425853 01-01-2005 Kemal KESKİN
.....

seri bitene kadar devam edecek şekilde seri üretmek istiyorum.

 

[isakarakus]

anladığım kadarıyla bu kodun işinixi görmesi lazım.

Private Sub CommandButton1_Click()
g = 0

For i = textbox1.Text To text2.Text
g = g + 1

Cells(i, 2) = g & "-" & i & " " & textbox3.Text & " " & Textbox4.Text

Next
End Sub

 

[Korhan Ayhan]

Sayın isakarakus;

Verdiğiniz kodları denedim. Ama verileri tek hücrede birleştirerek aktarıyor. Benim örneğimde anlatmak istediğim bu değildi. Aşağıdaki gibi olması gerekiyor. (Yanlış sordum galiba)

A sütununa sıra no atayacak, B sütununa seri atayacak, C sütununa tarih atayacak, D sütununa da isim atayacak şekilde olmasını istiyorum.

İyi çalışmalar dilerim.

 

[isakarakus]

edit..
tamam o zaman,

Private Sub CommandButton1_Click() 
g = 0 

For i = Textbox1.Text To Text2.Text 
g = g + 1 

Cells(g, 1) = g
Cells(g, 2) = i
Cells(g, 3) = Textbox3.Text
Cells(g, 4) = Textbox4.Text 

Next 
End Sub

cells(i,1) satırında i satır numarasını, 1 de sutun numarasını ifade eder,
yani 1,A sutunu, 2 b sutunu, 3 c sutunu 4 ise d sutununu ifade eder,
eğer başka sutunlara aktarmak istersenin bu kodları değiştirebilirsiniz.

 

[isakarakus]

merhaba,
bu kodlar size daha faydalı olacaktır.

Private Sub CommandButton1_Click()
Range("a65536").End(xlUp).Select
For i = Textbox1.Text To Text2.Text
ActiveCell.Offset(1, 0).Select

ActiveCell = g
ActiveCell.Offset(0, 1) = i
ActiveCell.Offset(0, 2) = Textbox3.Text
ActiveCell.Offset(0, 3) = Textbox4.Text
Next

End Sub

 

[Korhan Ayhan]

Sayın isakarakus;

Son verdiğiniz kodlarda ise istediğim sonuca ulaştım fakat bu seferde sıra numarası hatalı oldu.

İlk seriyi girdiğimde problem yok fakat ikinci seriyi girdiğimde sıra no tekrar 1 den başlıyor. Ama aslında son kaldığı yerden devam etmesi gerekiyor.

İyi çalışmalar dilerim.

 

[isakarakus]

kodu şöyle düzeltin.
[vb:1:5330c884a1]Private Sub CommandButton1_Click()
Range("a65536").End(xlUp).Select

g=activecell+1

For i = Textbox1.Text To Text2.Text

ActiveCell.Offset(1, 0).Select
ActiveCell = g
ActiveCell.Offset(0, 1) = i
ActiveCell.Offset(0, 2) = Textbox3.Text
ActiveCell.Offset(0, 3) = Textbox4.Text
g=g+1
Next

End Sub[/vb:1:5330c884a1]
g=activecell+1 ve
g=g+1
satırları eklendi

 

[Korhan Ayhan]

Sayın isakarakus;

g=activecell+1

Bu bölümde hata verdi. (Type Mistmatch)
Benim tablomda ilk satırda başlıklar var bundan kaynaklanmış olabilir mi?
Ã?rnek dosyam ektedir.

İyi çalışmalar dilerim.

 

[isakarakus]

zip olarak gönderir misiniz...

 

[Korhan Ayhan]

Dosyanın zipli hali ektedir.

 

[isakarakus]

bu şekilde değiştirmeniz yeterli,

G = Val(ActiveCell) + 1

 

[Korhan Ayhan]

Teşekkür ederim. :hey:

 

[Korhan Ayhan]

Selam arkadaşlar;

Aşağıdaki kodlarla kayıt işlemimi yapıyorum. Fakat mükerrer kayıt işlemini engelleyemedim. (Kayıtlarım D sütununda) Aşağıdaki kodda D sütununa göre nasıl bir düzeltme yapmam lazım ?


Private Sub CommandButton1_Click()
If TextBox1.Value = "" Or ComboBox1.Value = "" Or TextBox2.Value = "" Or TextBox3.Value = "" Or ComboBox2.Value = "" Or ComboBox2.Value = "" Then
MsgBox ("Kayıt ekleme işlemi için gerekli tüm bölümlere veri girmelisiniz." & Chr(10) & "Lütfen formdaki boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "DİKKAT !"
TextBox1.SetFocus
Else
If TextBox2.Value > TextBox3.Value Then
MsgBox ("Adisyon başlangıç numarası bitiş numarasından büyük olamaz." & Chr(10) & "Lütfen girdiğiniz değerleri kontrol ediniz."), vbExclamation, "DİKKAT !"
TextBox2.SetFocus
Else

Sheets("ZİMMET").Select
For Each AYNI In Range("D265536")
If AYNI.Value = TextBox2.Value Then
MsgBox ("Eklemek istediğiniz kayıt zaten listenizde bulunmaktadır."), vbExclamation, "DİKKAT !"
TextBox2.Value = ""
TextBox2.SetFocus
Exit Sub
End If
Next AYNI

Range("A65536").End(xlUp).Select
G = Val(ActiveCell) + 1
For i = TextBox2.Text To TextBox3.Text
ActiveCell.Offset(1, 0).Select

ActiveCell = G & "-"
ActiveCell.Offset(0, 1) = TextBox1.Text
ActiveCell.Offset(0, 2) = ComboBox1.Text
ActiveCell.Offset(0, 3) = i
ActiveCell.Offset(0, 4) = ComboBox2.Text
ActiveCell.Offset(0, 5) = "EVET"
G = G + 1
Next

Range("B2").Select
TextBox1 = ""
ComboBox1 = ""
TextBox2 = ""
TextBox3 = ""
ComboBox2 = ""
TextBox1.SetFocus
MsgBox ("Kayıt ekleme işlemi tamamlanmıştır."), vbInformation, "DİKKAT !"

End If
End If
End Sub

 

[Levent Menteşoğlu]

Sheets("ZİMMET").Select
For Each AYNI In Range("D265536")
If AYNI.Value = TextBox2.Value Then
MsgBox ("Eklemek istediğiniz kayıt zaten listenizde bulunmaktadır."), vbExclamation, "DİKKAT !"
TextBox2.Value = ""
TextBox2.SetFocus
Exit Sub
End If
Next AYNI

Yukarıdaki bölüm yerine aşağıdaki gibi deneyin.

[vb:1:a333d50c8e]say = WorksheetFunction.CountIf(Sheets("ZİMMET").columns(4), textbox2.Value)
If say > 0 Then
MsgBox ("Eklemek istediğiniz kayıt zaten listenizde bulunmaktadır."), vbExclamation, "DİKKAT !"
textbox2.Value = ""
textbox2.SetFocus
Exit Sub
End If
[/vb:1:a333d50c8e]