• DİKKAT

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

verileri silerken başka bir sayfaya aktarma

A

agreee

Katılım
4 Mayıs 2009
Mesajlar
64
Excel Vers. ve Dili
excel 2003
'Sil
Private Sub Label37_Click()

If TextBox2 = "" Then
MsgBox "Önce silinecek verileri seçin!!!", vbExclamation
Exit Sub
End If
i = TextBox1.Text
s = MsgBox(i & " Sıra No'lu kaydı silmek istiyor musunuz?", vbInformation + vbYesNo)
'if textbox1.Text = 1 then
Application.ScreenUpdating = False
If s = vbYes Then
sayfa1.Range("A" & i + 1 & ":" & "DA" & i + 1).Delete
p = WorksheetFunction.CountA(sayfa1.Range("A:A"))

For k = 2 To p
sayfa1.Range("A" & k).Value = k - 1
Next k
If sayfa1.Range("A2").Value <> "" Then
ListBox1.RowSource = "sayfa1!a2:e" & p
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "30;45;60;45"
End If
sayfa1.Range("a1").Select

TextBox1.Text = p
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox13.Text = ""
TextBox14.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox17.Text = ""
TextBox18.Text = ""
TextBox19.Text = ""
TextBox20.Text = ""
TextBox21.Text = ""
TextBox22.Text = ""
TextBox23.Text = ""
TextBox24.Text = ""
TextBox25.Text = ""
TextBox26.Text = ""
TextBox27.Text = ""
TextBox31.Text = ""
TextBox32.Text = ""
TextBox33.Text = ""
TextBox34.Text = ""
TextBox35.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
TextBox42.Text = ""
TextBox43.Text = ""
TextBox44.Text = ""
TextBox45.Text = ""
TextBox46.Text = ""
TextBox47.Text = ""
TextBox48.Text = ""
TextBox49.Text = ""
TextBox50.Text = ""
TextBox51.Text = ""
TextBox52.Text = ""
TextBox53.Text = ""


ElseIf s = vbNo Then
p = WorksheetFunction.CountA(sayfa1.Range("A:A"))
TextBox1.Text = p
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox13.Text = ""
TextBox14.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox17.Text = ""
TextBox18.Text = ""
TextBox19.Text = ""
TextBox20.Text = ""
TextBox21.Text = ""
TextBox22.Text = ""
TextBox23.Text = ""
TextBox24.Text = ""
TextBox25.Text = ""
TextBox26.Text = ""
TextBox27.Text = ""
TextBox31.Text = ""
TextBox32.Text = ""
TextBox33.Text = ""
TextBox34.Text = ""
TextBox35.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
TextBox42.Text = ""
TextBox43.Text = ""
TextBox44.Text = ""
TextBox45.Text = ""
TextBox46.Text = ""
TextBox47.Text = ""
TextBox48.Text = ""
TextBox49.Text = ""
TextBox50.Text = ""
TextBox51.Text = ""
TextBox52.Text = ""
TextBox53.Text = ""


Exit Sub
End If

Application.ScreenUpdating = True

End Sub

naıl başka sayfaya aktarıırm listboxtan seçiyorum sil diyorum silerken başka sayfaya bütün textboxdaki bilgileri aktarmak istiyorum teşekkürler
 
kodlara bakarak söylemek zor ama deneyelim,

Kod: 
Private Sub Label37_Click()
If TextBox2 = "" Then
MsgBox "Önce silinecek verileri seçin!!!", vbExclamation
Exit Sub
End If
i = TextBox1.Text
s = MsgBox(i & " Sıra No'lu kaydı silmek istiyor musunuz?", vbInformation + vbYesNo)
'if textbox1.Text = 1 then
Application.ScreenUpdating = False
If s = vbYes Then
'-----eklenenkodlar----sayfa2ye kaydedeceksek-ilk-boş-satıra-yazılacak---
fd = Sheets("sayfa2").Range("A65536").End(xlUp).Row + 1
for f=1 to 53
Sheets("sayfa2").cells(fd,f).value=controls("textbox"&f).text
next
'-------------------------------------------------------------------------
sayfa1.Range("A" & i + 1 & ":" & "DA" & i + 1).Delete
p = WorksheetFunction.CountA(sayfa1.Range("A:A"))

For k = 2 To p
sayfa1.Range("A" & k).Value = k - 1
Next k
If sayfa1.Range("A2").Value <> "" Then
ListBox1.RowSource = "sayfa1!a2:e" & p
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "30;45;60;45"
End If
sayfa1.Range("a1").Select

TextBox1.Text = p
for s= 2 to 53
controls("TextBox"&s).text = ""
next

ElseIf s = vbNo Then
p = WorksheetFunction.CountA(sayfa1.Range("A:A"))
TextBox1.Text = p
for s= 2 to 53
controls("TextBox"&s).text = ""
next
Exit Sub
End If

Application.ScreenUpdating = True
End Sub
umarım olur. :)
saygılar.
 
fedeal' Alıntı:
kodlara bakarak söylemek zor ama deneyelim,

Kod: 
Private Sub Label37_Click()
If TextBox2 = "" Then
MsgBox "Önce silinecek verileri seçin!!!", vbExclamation
Exit Sub
End If
i = TextBox1.Text
s = MsgBox(i & " Sıra No'lu kaydı silmek istiyor musunuz?", vbInformation + vbYesNo)
'if textbox1.Text = 1 then
Application.ScreenUpdating = False
If s = vbYes Then
'-----eklenenkodlar----sayfa2ye kaydedeceksek-ilk-boş-satıra-yazılacak---
fd = Sheets("sayfa2").Range("A65536").End(xlUp).Row + 1
for f=1 to 53
Sheets("sayfa2").cells(fd,f).value=controls("textbox"&f).text
next
'-------------------------------------------------------------------------
sayfa1.Range("A" & i + 1 & ":" & "DA" & i + 1).Delete
p = WorksheetFunction.CountA(sayfa1.Range("A:A"))

For k = 2 To p
sayfa1.Range("A" & k).Value = k - 1
Next k
If sayfa1.Range("A2").Value <> "" Then
ListBox1.RowSource = "sayfa1!a2:e" & p
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "30;45;60;45"
End If
sayfa1.Range("a1").Select

TextBox1.Text = p
for s= 2 to 53
controls("TextBox"&s).text = ""
next

ElseIf s = vbNo Then
p = WorksheetFunction.CountA(sayfa1.Range("A:A"))
TextBox1.Text = p
for s= 2 to 53
controls("TextBox"&s).text = ""
next
Exit Sub
End If

Application.ScreenUpdating = True
End Sub
umarım olur. :)
saygılar.
Genişletmek için tıkla ...

OLMADI dostum :(
 
olması zaten ufak bir ihtimaldi,Evren hocamızın bir sözü var kod anlatılmaz yazılır.özel mesajda bahsettiginizle 1.mesajdaki soru bence çok farklı bir örnek dosya eklerseniz yardımcı olacak çok kişi olabilir,saygılar.
 
Kod: 
fd = Sheets("ÇIKIŞ").Range("A65536").End(xlUp).Row + 1
For f = 1 To 27
Sheets("ÇIKIŞ").Cells(fd, f).Value = Controls("textbox" & f).Text
Next
For f = 31 To 38
Sheets("ÇIKIŞ").Cells(fd, f - 3).Value = Controls("textbox" & f).Text
Next
For f = 40 To 53
Sheets("ÇIKIŞ").Cells(fd, f - 4).Value = Controls("textbox" & f).Text
Next

Aynı yere bu satırları ilave ettim oldu gibi ama bi kontrol edin çalışmaya çıkış sayfası ekledim oraya kaydediyor.
not :daha önce hatanın nedeni çalışmada textbox 28,29,30,39 un olmamısıymış.

birde çalışmanızdaki kodları for döngüsüyle kısaltırsanız hem boyuttan hem çalışma veriminden kazanırsınız örnegin;

Kod: 
TextBox1.Text = p
    TextBox2.Text = ""
    TextBox3.Text = ""
    TextBox4.Text = ""
    TextBox5.Text = ""
    TextBox6.Text = ""
    TextBox7.Text = ""
    TextBox8.Text = ""
    TextBox9.Text = ""
    TextBox10.Text = ""
    TextBox11.Text = ""
    TextBox12.Text = ""
    TextBox13.Text = ""
    TextBox14.Text = ""
    TextBox15.Text = ""
    TextBox16.Text = ""
    TextBox17.Text = ""
    TextBox18.Text = ""
    TextBox19.Text = ""
    TextBox20.Text = ""
    TextBox21.Text = ""
    TextBox22.Text = ""
    TextBox23.Text = ""
    TextBox24.Text = ""
    TextBox25.Text = ""
    TextBox26.Text = ""
    TextBox27.Text = ""
    TextBox31.Text = ""
    TextBox32.Text = ""
    TextBox33.Text = ""
    TextBox34.Text = ""
    TextBox35.Text = ""
    TextBox36.Text = ""
    TextBox37.Text = ""
    TextBox38.Text = ""
    TextBox40.Text = ""
    TextBox41.Text = ""
    TextBox42.Text = ""
    TextBox43.Text = ""
    TextBox44.Text = ""
    TextBox45.Text = ""
    TextBox46.Text = ""
    TextBox47.Text = ""
    TextBox48.Text = ""
    TextBox49.Text = ""
    TextBox50.Text = ""
    TextBox51.Text = ""
    TextBox52.Text = ""
    TextBox53.Text = ""

yerine;

Kod: 
TextBox1.Text = p
For f = 2 To 27
Controls("textbox" & f).Text= ""
Next
For f = 31 To 38
Controls("textbox" & f).Text= ""
Next
For f = 40 To 53
Controls("textbox" & f).Text= ""
Next

kullanabilirsiniz,saygılar.
 

Ekli dosyalar

Merhaba

dosyayı açtığımda "could not load an object because ıt ıs not avaılable on thıs machıne" uyarısı verıyor. Userform11,12,13,14,15,17,18,19,20,21,22,5,7 vb'den görmek istediğimde boş userform gösteriyor. Neden kaynaklanıyor acaba.
 
O yazdığım userformlar boşmu?
Yada içinde hangi nesne var da o uyarıyı veriyor ?
 
o userformların bazılarında yada hepsinde olan bir özellik yada bir nesne desteği benim office uygulamamda olmadığı için hata veriyor. o hatayı vermeden açılması için benim makinamdaki excelde o özelleğinde olması gerekiyor. bu sorunu gidermem için soruyorum.
 
toolbox a gir controls boşluğa tıkla eksik olan objeyi ordan ekleyebilirsin ama ne eksik sende bilemiyorum
 
evet hala sorun var
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst