Userformda açılan textbox değerlerini excel sayfasına sıralı şekilde yazdırma

[ekrgz]

Userform'da checkboxlar ile seçilen 33 tane il var. Bu iller seçildiği zaman yanlarında textboxlar oluşuyor ve değerler giriliyor. Bu girilen değerleri ve karşısına gelen şehirleri sırasıyla excel sayfasına yazdırmak istiyorum.

 

[ÖmerFaruk]

Sorunuz https://www.excel.web.tr/threads/textbox-silme.198862/ başlığındaki konuya dair ise hem kodlarınızı hem dosyanızı komple paylaşır mısınız?

 

[ekrgz]

Sub auto_open()
UserForm1.Show
End Sub
Sub veri_alma()
With UserForm1
Dim aracsayisi As Integer
aracsayisi = TextBox1.Text
Dim arackapasitesi As Integer
arackapasitesi = TextBox2.Text
Dim aracdarasi As Integer
aracdarasi = TextBox3.Text
End With
End Sub

Sub siparis_ayristir()
Dim k As Integer
Dim m, i, son_hucre As Integer
Dim ilk1, ilk2, ilk3 As Integer
Sheets("sayfa4").Select
ilk3 = Range("b1").End(4).row
son_hucre = WorksheetFunction.CountA(Range("b1:b1000"))
k = ilk3 - son_hucre
m = 5

For i = 1 To son_hucre / 2
Sheets("sayfa4").Cells(m, 3) = Sheets("sayfa4").Cells(ilk3, 2).Value
Sheets("sayfa4").Cells(m, 4) = Sheets("sayfa4").Cells(ilk3 + 1, 2).Value
m = m + 1
ilk3 = ilk3 + 2
Next i


ilk1 = Range("c1").End(4).row
ilk2 = Range("d1").End(4).row

Range("c" & ilk1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("sayfa3").Activate
Range("c5").Select
ActiveSheet.Paste

Sheets("sayfa4").Activate
Range("d" & ilk2).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("sayfa3").Activate
Range("d5").Select
ActiveSheet.Paste
Range("c4:d4").Value = "*"
Range("c4:d4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub

Sub alt_matrism()
Dim i, j As Integer
Sheets("sayfa1").Select
Range("c4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Name = "satir_sehirler"
satir_sehirlerno = Range("satir_sehirler").Rows.Count
Range("d3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Name = "sutun_sehirler"
sutun_sehirlerno = Range("sutun_sehirler").Columns.Count
Range("a1").Select

sutnindex = 0

For j = 1 To sutun_sehirlerno
Sheets("sayfa1").Select
veriIndex = 0
For i = 4 To satir_sehirlerno + 3
Sheets("sayfa1").Select
Cells(i, 1).Select
Cells(1, j + 3).Select
If Cells(i, 1).Value = 1 And Cells(1, j + 3).Value = 1 Then
Cells(i, j + 3).Select
Selection.Copy
Sheets("sayfa3").Select
Cells(5 + veriIndex, sutnindex + 7).Select
ActiveSheet.Paste
veriIndex = veriIndex + 1
End If
Application.CutCopyMode = False
Next i
Sheets("sayfa1").Select
If Cells(1, j + 3).Value = 1 Then sutnindex = sutnindex + 1
Next j
End Sub
Sub sehirkodu_yaz()
Dim i, j As Integer
Sheets("sayfa1").Select
Range("c4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Name = "satir_sehirler"
satir_sehirlerno = Range("satir_sehirler").Rows.Count
Hsay = 0
For i = 4 To satir_sehirlerno + 3
Sheets("sayfa1").Select
Cells(i, 1).Select
If Cells(i, 1).Value = 1 Then
Cells(i, 2).Select
Selection.Copy
Sheets("sayfa3").Select
Cells(5 + Hsay, 6).Select
ActiveSheet.Paste
Hsay = Hsay + 1
End If
Next i
Range("d3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Name = "sutun_sehirler"
sutun_sehirlerno = Range("sutun_sehirler").Columns.Count
Tsay = 0
For j = 1 To sutun_sehirlerno
Cells(1, j + 3).Select
If Cells(1, j + 3).Value = 1 Then
Cells(2, j + 3).Select
Selection.Copy
Sheets("sayfa3").Select
Cells(4, Tsay + 7).Select
ActiveSheet.Paste
Tsay = Tsay + 1
Worksheets("sayfa1").Select
End If
Application.CutCopyMode = False
Next j

End Sub
Sub sehir_secme()
Dim i, j, r, k, lRow, lColumn As Integer
Sheets("Sayfa1").Activate
k = 0
ActiveSheet.Columns("c").Find(UserForm1.ComboBox1.Value).Offset(0, -1).Select
ActiveCell = k
ActiveSheet.Columns("c").Find(UserForm1.ComboBox1.Value).Offset(0, -2).Select
ActiveCell = 1
ActiveSheet.Rows(3).Find(UserForm1.ComboBox1.Value).Offset(-1, 0).Select
ActiveCell = k
ActiveSheet.Rows(3).Find(UserForm1.ComboBox1.Value).Offset(-2, 0).Select
ActiveCell = 1
r = 1
lRow = Cells(Rows.Count, 3).End(xlUp).row
lColumn = Cells(3, Columns.Count).End(xlToLeft).column
For i = 4 To lRow
If UserForm1.Controls("CheckBox_" & i).Value = True Then
Worksheets("Sayfa1").Cells(i, 2).Value = r
r = r + 1
Cells(i, 1) = 1
End If
Next i
r = 1
For j = 4 To lColumn
If UserForm1.Controls("CheckBox_" & j).Value = True Then
Worksheets("Sayfa1").Cells(2, j).Value = r
r = r + 1
Cells(1, j) = 1
End If
Next j

End Sub
Sub satir_sirala()
Dim Hdr As Range, Rng As Range
Sheets("sayfa3").Activate
Set Hdr = Range("f5", Range("f5").End(xlDown))
Set Rng = Range(Hdr, Hdr.End(xlToRight))
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Hdr, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Rng
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub sutun_sirala()
Dim Hdr As Range, Rng As Range
Sheets("sayfa3").Activate
Set Hdr = Range("g4", Range("g4").End(xlToRight))
Set Rng = Range(Hdr, Hdr.End(xlDown))
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Hdr, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Rng
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub temizle_bastan()
Sheets("sayfa1").Select
Range("d1:fb1").Clear
Range("d2:fb2").Clear
Range("a4:a500").Clear
Range("b4:b500").Clear
Sheets("sayfa3").Select
Range("a4:fb500").Clear
Sheets("sayfa4").Select
Range("a1:fb300").Clear
End Sub

 

[ekrgz]

Dosya paylaşımı yapamıyorum fakat checkboxlarla seçilecek şehirleri işaretliyoruz ve karşılarına textbox geliyor. Sonrasında verileri silip yeni şehirler seçince, textboxları silemediğimiz icin yeni yazılan değerler üst üste geliyor ve başka sayfaya yazdırma işlemi gerçekleştirilebiliyor. Bu yüzden her seçimden sonra textboxları sildirmek istiyoruz

 

[ÖmerFaruk]

Merhaba,
Dosyanızı harici dosya yükleme sitelerine yükleyerek link verebilirsiniz.

Bun harici dosya yükleme siteleri aşağıdakilerden birisi olabilir.
Dosya.co
Upload.com
Wetransfer.com
Kişisel Drive ya da Bulut hesaplarınız (İndirme izni verilerek)

 

[ekrgz]

arac_rotalama_tez5.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl