Veri aktarımı

[oguzgok]

Mrb Arkadaşlar....
İki sorum olacaktı.. Yardımcı olacak arkadaşıma şimdiden teşekkürlerimi sunarım..
Birinci sorum?
Aşağıdaki kod ile, Textbox2 deki değeri, Veri sayfasındaki 53. sütundan itibaren kaydetmeye başlıyor. Ancak, ikinci kayıtta ise son kayıttan itibaren 53 sütun atlayarak kayıt yapıyor. Benim istediğim her kayıtta tek sütun atlayarak kayıt yapması.
Aşağıdaki kodda nasıl bir değişiklik yapmalıyız?

Private Sub CommandButton1_Click()
For Each alan In Sheets("VERİ").Range("B6:B2000")
If TextBox1.Value = alan.Value Then
alan.Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 53).Select
Loop
ActiveCell.Value = TextBox2.Value
End If
Next
[A6].Select
End Sub

İkinci sorum ise;
Yukardaki koda, Textbox2 deki değerin, Textbox3 deki değeri geçmesi halinde kayıt yapmayıp uyarı mesajı versin...

Şimdiden çok tşk eder çalışmalarınızda başarılar dilerim...

 

[Recep İpek]

Kodlarınızı aşağıdaki şekilde değiştiriniz.

Private Sub CommandButton5_Click()
On Error Resume Next
If TextBox2.Value > TextBox3.Value Then
MsgBox "Mesajınız"
Exit Sub
End If
If TextBox2.Value = "" Then Exit Sub
For Each alan In Sheets("VERİ").Range("B6:B2000")
If TextBox1.Value = alan.Value Then
alan.Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Value = TextBox2.Value
End If
Next
[A6].Select
End Sub

 

[oguzgok]

Sn. Ripek..
Ellerine sağlık..Ancak, kayıdın 53. sütundan başlamasını istiyorum ve tek tek artarak yani 53 bir sonraki kayıt 54. sütun bir sonraki 55. sütun.....
Tşk ediyorum..

 

[oguzgok]

Artı bir soru daha gelebilir mi ?
Combobox veya Tekxtbox daki bir değere göre, o değerin bulunduğu satırın silinmesi hakkında küçük bir kod rica edebilirmiyim.. Tşk..

 

[Recep İpek]

1.sorunuz için sanırım aşağıdaki gibi olmasını istiyorsunuz.

Private Sub CommandButton5_Click()
On Error Resume Next
If TextBox2.Value > TextBox3.Value Then
MsgBox "Mesajınız"
Exit Sub
End If
If TextBox2.Value = "" Then Exit Sub
For Each alan In Sheets("VERİ").Range("B6:B2000")
If TextBox1.Value = alan.Value Then
alan.Offset(0,54).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Value = TextBox2.Value
End If
Next
[A6].Select
End Sub

2.sorunuz için;

Private Sub CommandButton6_Click()
On Error Resume Next
If TextBox2.Value = "" Then Exit Sub
For Each alan In Sheets("VERİ").Range("B6:B2000")
If TextBox1.Value = alan.Value Then
If (MsgBox("İlgili Kayıtı Silmek İstiyormusunuz?", vbCritical + vbDefaultButton2 + vbYesNo, "UYARI")) = vbYes Then
Selection.EntireRow.Delete
End If
End If
Next
[A6].Select
End Sub

 

[oguzgok]

Sn. Ripek..
Çok teşekkür ederim. Ellerinize sağlık...

 

[oguzgok]

Sn. Ripek... kodu yeni deneme şansım oldu... Ama olmadı...
kayıt 53. sütundan başlayacak ve 54,55,56 ncı sütun olarak kayıt yapacak..Yani 53. sütundan başlayarak tek tek kayıt yapsın istiyorum.
Ancak yazılan kod 53 sutn atlayarak kayıt yapıyor..
Yardımlarınızı bekliyorum...

 

[Recep İpek]

alan.Offset(0,54).Select

satırını

alan.Offset(0,51).Select

olarak değiştirin.Yazdığım kod Textbox1'deki veriyi B sütününda buluyor.Bulduğu satırın 53.sütünundan itibaren son boş hücreye Textbox2'deki veriyi kaydetiyor.

Ben denediğimde çalışıyor.Yada ben sorunuzu yanlış anlamış da olabilirim.Yine de olmazsa küçük bir örnek ekleyebilirmisiniz?

 

[oguzgok]

Sn. Ripek.. Hata bende kaynaklanmış...
Herşey için çok teşekkür ederim. Şu an çalışıyor... Elinize sağlık...