• DİKKAT

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

Textbox verilerinin yer değiştirmesi

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

mtozer

Katılım
9 Ekim 2007
Mesajlar
216
Excel Vers. ve Dili
Office2000
Merhaba;

Bir dizi halinde Textbox satırlarım var. Her satır A-B-C-D... diye isimlendirilmiş. Her satırın başında ayrı bir TextBox var. Satır halindeki textboxlardaki verilerin yer değiştirmesine ihtiyacım var. Yani Hersatırın başındaki Box a örneğin ; "C" satırında iken "E" yazdım. "C" satırı olduğu gibi "E" satırına gitmeli. İncelerseniz sevinirim.

http://s6.dosya.tc/server5/gskyjf/text.xlsx.html


İyi çalışmalar.
 
Dosyayı kontrol ediniz. Yanlışlık varsa bilgi veriniz . Dosya üzerinde elle yazılmış veri (bilgi) olmayınca anca bu kadar.
Dosya Linki
 

Ekli dosyalar

Eğer A-B-C-D "A" sütununda ise form üzerindeki kodları aşağıdaki ile değiştirin.
Kod: 
Private Sub CommandButton1_Click()
On Error Resume Next
x = 2
deg = TextBox1.Text
Set satır = Range("A:A").Find(deg, , xlValues, xlWhole)
b = satır.Row
For i = 2 To 8
Cells(b, x).Value = Controls("TextBox" & i).Value
x = x + 1
Next

x = 2
deg1 = TextBox9.Text
Set satır1 = Range("A:A").Find(deg1, , xlValues, xlWhole)
b1 = satır1.Row
For i = 10 To 16
Cells(b1, x).Value = Controls("TextBox" & i).Value
x = x + 1
Next

x = 2
deg2 = TextBox17.Text
Set satır2 = Range("A:A").Find(deg2, , xlValues, xlWhole)
b2 = satır2.Row
For i = 18 To 24
Cells(b2, x).Value = Controls("TextBox" & i).Value
x = x + 1
Next

x = 2
deg3 = TextBox25.Text
Set satır3 = Range("A:A").Find(deg3, , xlValues, xlWhole)
b3 = satır3.Row
For i = 26 To 32
Cells(b3, x).Value = Controls("TextBox" & i).Value
x = x + 1
Next

x = 2
deg4 = TextBox33.Text
Set satır4 = Range("A:A").Find(deg4, , xlValues, xlWhole)
b4 = satır4.Row
For i = 34 To 40
Cells(b4, x).Value = Controls("TextBox" & i).Value
x = x + 1
Next

x = 2
deg5 = TextBox41.Text
Set satır5 = Range("A:A").Find(deg5, , xlValues, xlWhole)
b5 = satır5.Row
For i = 42 To 48
Cells(b5, x).Value = Controls("TextBox" & i).Value
x = x + 1
Next

End Sub
 
Tesekkur ederim ancak, yer degistirse daha iyi olur. Gonderilen satiri silmesi degilde yer degistirmesi daha iyi olur. Ayrica bendeki format farkli text box sayisini belirlemem yeterlimidir.
 
Aşağıdaki satırları silerseniz sadece yer değiştirir.
Kod: 
For i = 1 To 7
Controls("A" & i).Value = ""
A.Value = ""
Next

For i = 1 To 7
Controls("B" & i).Value = ""
B.Value = ""
Next
..............
 
Bu satirlari sildim ancak, Bu defa kopyalama yapti. Yer degistirmedi. Amacim "c" yazinca c Deki ilgili textlere ilgili texttekiler c ye yer degistirsin istiyorum.
 
Sayın mtozer
İlk satırın kodları aşağıda diğerlerini buna göre değiştirin.
Kod: 
Private Sub A_Change()
On Error Resume Next
If A.Value <> "" Then
If Len(A) = 1 And Asc(A) >= 65 And Asc(A) <= 70 Then
For i = 1 To 7
AA = Controls("A" & i)
DE = Controls(Controls("A").Value & i)
Controls(Controls("A").Value & i).Value = AA
Controls("A" & i).Value = DE
Next
End If
End If
End Sub
 
Son düzenleme:
Su sekilde ali hocam; d satirinda iken c yazdigimda d satiri ile d satiri yerdegissin istiyorum.
 
yukarıdaki 10 nolu mesajdaki kodları değiştirdim
 
Bu oldu herhalde
Kod: 
Private Sub A_Change()
On Error Resume Next
If A.Value <> "" Then
If Len(A) = 1 And Asc(A) >= 65 And Asc(A) <= 70 Then
For i = 1 To 7
AA = Controls("A" & i)
DE = Controls(Controls("A").Value & i)
Controls(Controls("A").Value & i).Value = AA
Controls("A" & i).Value = DE
Next
End If
End If
End Sub


Private Sub B_Change()
On Error Resume Next
If B.Value <> "" Then
If Len(B) = 1 And Asc(B) >= 65 And Asc(B) <= 70 Then
For i = 1 To 7
BB = Controls("B" & i)
DE = Controls(Controls("B").Value & i)
Controls(Controls("B").Value & i).Value = BB
Controls("B" & i).Value = DE
Next
End If
End If
End Sub
Private Sub C_Change()
On Error Resume Next
If C.Value <> "" Then
If Len(C) = 1 And Asc(C) >= 65 And Asc(C) <= 70 Then
For i = 1 To 7
CC = Controls("C" & i)
DE = Controls(Controls("C").Value & i)
Controls(Controls("C").Value & i).Value = CC
Controls("C" & i).Value = DE
Next
End If
End If
End Sub
Private Sub D_Change()
On Error Resume Next
If D.Value <> "" Then
If Len(D) = 1 And Asc(D) >= 65 And Asc(D) <= 70 Then
For i = 1 To 7
DD = Controls("D" & i)
DE = Controls(Controls("D").Value & i)
Controls(Controls("D").Value & i).Value = DD
Controls("D" & i).Value = DE
Next
End If
End If
End Sub
Private Sub E_Change()
On Error Resume Next
If E.Value <> "" Then
If Len(E) = 1 And Asc(E) >= 65 And Asc(E) <= 70 Then
For i = 1 To 7
EE = Controls("E" & i)
DE = Controls(Controls("E").Value & i)
Controls(Controls("E").Value & i).Value = EE
Controls("E" & i).Value = DE
Next
End If
End If
End Sub
Private Sub F_Change()
On Error Resume Next
If F.Value <> "" Then
If Len(F) = 1 And Asc(F) >= 65 And Asc(F) <= 70 Then
For i = 1 To 7
FF = Controls("F" & i)
DE = Controls(Controls("F").Value & i)
Controls(Controls("F").Value & i).Value = FF
Controls("F" & i).Value = DE
Next
End If
End If
End Sub
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst