Textbox verilerinin yer değiştirmesi

[mtozer]

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.

 

[mtozer]

http://s8.dosya.tc/server/5vvhkt/text1.rar.html

 

[vardar07]

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

 

[vardar07]

Eğer A-B-C-D "A" sütununda ise form üzerindeki kodları aşağıdaki ile değiştirin.

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

 

[mtozer]

resim ile anlatmaya çalıştım E satırındaki değerler A satırına A satırındakiler E ye (E satırına A diye belirttiğimiz için) yani textbox değerlerinin yer değiştirilmesi gerekiyor.

http://www.dosya.tc/server6/bb7tji/user.JPG.html

 

[alicimri]

Sayın mtozer
TextBox ların isimleri değiştirildi. A, A1, A2.........

http://s6.dosya.tc/server5/0el9es/TEST.xls.html

 

[mtozer]

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.

 

[alicimri]

Aşağıdaki satırları silerseniz sadece yer değiştirir.

For i = 1 To 7
Controls("A" & i).Value = ""
A.Value = ""
Next

For i = 1 To 7
Controls("B" & i).Value = ""
B.Value = ""
Next
..............

 

[mtozer]

Bu satirlari sildim ancak, Bu defa kopyalama yapti. Yer degistirmedi. Amacim "c" yazinca c Deki ilgili textlere ilgili texttekiler c ye yer degistirsin istiyorum.

 

[alicimri]

Sayın mtozer
İlk satırın kodları aşağıda diğerlerini buna göre değiştirin.

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

 

[mtozer]

Su sekilde ali hocam; d satirinda iken c yazdigimda d satiri ile d satiri yerdegissin istiyorum.

 

[alicimri]

yukarıdaki 10 nolu mesajdaki kodları değiştirdim

 

[mtozer]

Yukaridaki kodlarla olmayacak mi?

 

[alicimri]

Bu oldu herhalde

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