döngü ile userformdan veri değiştirme

[kemal turan]

Merhaba,
Textbox 60 ile 80 arasında değer girili olanları Döngü ile
Textbox 1 ile 20 arasındaki değerlerin aynı olduğu VERITABANI "A" Sununda aynı olan satır bilgilerinin değişim ve ekleme yapacak koda ihtiyacım var.
AşağıdacYapmaya çalıştığım ( çalışmayan) kod ek dosyadadır.
Teşekkür ederim.

Private Sub CommandButton4_Click()
Set s1 = Sheets("VERITABANI")
Dim bul As Range
For i = 1 To 20
If Controls("TextBox" & i) <> "" Then
For Each bul In Sheets("VERITABANI").Range("A2:A" & s1.Range("A65536").End(3).Row)
If bul.Text = Controls("TextBox" & i).Text Then
bul.Offset(0, 17).Value = "SEVK EDİLDİ"
bul.Offset(0, 29).Value = Controls("TextBox" & i + 60).Value * 1
bul.Offset(0, 30).Value = Date
End If
Next i
Next bul
End If
MsgBox "SEVK KAYDI YAPILMIŞTIR.."
End Sub

 

[PLİNT]

Merhaba
Arama ile daha kolay gibi görüyor olmazsa dosyanızı burayada eklermisiniz?
Sizin kodlar ile:

[SIZE="2"] Private Sub CommandButton4_Click()
Set s1 = Sheets("VERITABANI")
Dim bul As Range
For i = 1 To 20
If Controls("TextBox" & i) <> "" Then
If Controls("TextBox" & i + 60).Value <> "" Then
For Each bul In Sheets("VERITABANI").Range("A2:A" & s1.Range("A65536").End(3).Row)
If bul.Text = Controls("TextBox" & i).Text Then
s1.Cells(bul.Row, 18).Value = "SEVK EDİLDİ"
s1.Cells(bul.Row, 30).Value = Controls("TextBox" & i + 60).Value * 1
s1.Cells(bul.Row, 31).Value = Date
End If
Next
End If: End If
Next
MsgBox "SEVK KAYDI YAPILMIŞTIR.."
End Sub [/SIZE]

veya arama ile

[SIZE="2"]Private Sub CommandButton4_Click()
Set s1 = Sheets("VERITABANI")
Dim bul As Range
x = s1.Range("A65536").End(3).Row
For i = 1 To 20
If Controls("TextBox" & i) <> "" Then
If Controls("TextBox" & i + 60) <> "" Then
With s1.Range("a1:a" & x)
Set C = .Find(Controls("TextBox" & i), LookIn:=xlValues, lookat:=xlWhole)
    If Not C Is Nothing Then
s1.Cells(C.Row, 18).Value = "SEVK EDİLDİ"
s1.Cells(C.Row, 30).Value = Controls("TextBox" & i + 60).Value * 1
s1.Cells(C.Row, 31).Value = Date
    End If
End With
End If: End If
Next
MsgBox "SEVK KAYDI YAPILMIŞTIR.."
End Sub [/SIZE]

 

[kemal turan]

merhaba,
ilk defa yükledim inşaallah olmuştur.
Teşekkür ederim
http://s3.dosya.tc/server11/sxhlke/dongu_ile_veri_degistirme_ve_silme.rar.html

 

[kemal turan]

merhaba
her iki kodda
"c.Offset(0, 29).Value = Controls("TextBox" & i + 60).Value * 1" satırı
type mismatch şeklinde hata veriyor

 

[PLİNT]

Merhaba
Yukarıdaki değişen şekliyle deneyin,
"A" sütununda "ID" çok ise arama ile olan daha hızlı olacaktır

 

[kemal turan]

Sn.Plint,
Çok teşekkür ederim.
Selametle kalınız.