[Yardım]  Userform Listboxa göre veri aktarma

Metin Kutucuğu. Bir programcının olmazsa olmazlarındandır.

Userform Listboxa göre veri aktarma

İleti#1)  bilgeman » 10 Ekm 2019 21:22

Öncelikle merhaba

Benim elimde yaptığım ve hali hazırda kullandığım proje var ve ben buna yeni özellikler ekleme yapmak istiyorum.

Projede üretim formu sayfasına girdiğim verileri formu kaydet butonuna tıkladığım zaman hepsi diğer sayfalara kaydoluyor sıkıntı yok.Yapmak istediğim iki şey var.

1.Kesilen Ürünler sayfasında Kasa No Gir butonuna bastığımda çıkan userformda textboxa kasa no yazıp listboxa kaydediyorum ama alt alta 10 farklı kasa no girdiğim zaman sevket butonuna basınca listedeki kasa noya ait verilerin sevkedilenler sayfasına kaydedilmesini ve kesilen ürünler sayfasından silinmesini istiyorum.

2.Sevkedilen sayfasında sorgula butonuna basınca gelen userformdaki textboxa kasa noyu yazdığım zaman o kasa noya ait bilgiler messagebox a yazdırmak.Bu konularla ilgili yardımcı olursanız sevinirim.Dosya ektedir.

https://s2.dosya.tc/server10/k1merv/Uretim_Formu_2019_SABLON.rar.html
Kullanıcı avatarı
bilgeman
 
Adı Soyadı:Mümin Soybelli
Kayıt: 18 Tem 2013 12:44
İleti: 2
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa

Cevap: Userform Listboxa göre veri aktarma

İleti#2)  ahmetonline » 14 Ekm 2019 16:22

listboxtan seçilen verileri aktararak yapabilirsin
asağıdaki kodları kendine göre uyarla
Kod: Tümünü seç
Private Sub UserForm_Initialize()
Dim i As Long
ListBox1.ColumnCount = 4
    ListBox1.MultiSelect = fmMultiSelectMulti

With Sheets("sayfa1")
    For i = 2 To .Range("a65536").End(3).Row
        ListBox1.AddItem .Cells(i, 1).Value
        ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(i, 2).Value
        ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(i, 3).Value
        ListBox1.List(ListBox1.ListCount - 1, 3) = .Cells(i, 4).Value
    Next i
End With
i = Empty
End Sub

Private Sub CommandButton1_Click()
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        With Sheets("sayfa2")
            Sheets("sayfa1").Range("a1:d1").Copy .Range("a1")
            .Range("a65536").End(3)(2, 1).Value = ListBox1.List(i, 0)
            .Range("a65536").End(3)(1, 2).Value = ListBox1.List(i, 1)
            .Range("a65536").End(3)(1, 3).Value = ListBox1.List(i, 2)
            .Range("a65536").End(3)(1, 4).Value = ListBox1.List(i, 3)
        End With
    End If
Next i
i = Empty
MsgBox "Seçtiğiniz veriler aktarılmıştır.", vbInformation, "Www.ExcelVBA.Net"
Sheets("sayfa2").Select
End Sub
Kullanıcı avatarı
ahmetonline
Yeni Başlamış
 
Kayıt: 16 May 2018 12:16
Meslek: serbest
Yaş: 39
İleti: 78
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: kocaeli

Cevap: Userform Listboxa göre veri aktarma

İleti#3)  bilgeman » 14 Ekm 2019 21:35

Yardımınız için teşekkürler ancak benim yapmak istediğim bu değil çünkü bu veriler zamanla binlerce satır olacak benim istediğim textboxa kasa no yazıp listboxa aktarmak bunu yapabiliyorum ve listboxa eklenen kasa no verilerine göre arama yapacak ve bulduğu satırı sevkedilen sayfasına aktarak ve kesilen sayfasından silecek

Aşağıdaki kodda kesilen sayfasından kaç tane kasa no yazarsanız hepsini siliyor ancak sevkedilen sayfasına aktarmıyor halletmem gereken sorun bu.Bu konuda yardımcı olursanız sevinirim.

Kod: Tümünü seç
Private Sub CommandButton1_Click()

Dim sevkedilen As Worksheet
Dim kesilen As Worksheet

Set sevkedilen = Sheets("Sevkedilenler")
Set kesilen = Sheets("Kesilen Ürünler")
'--------------------------------------------------------------------------------
If ListBox1.ListCount = 0 Then
MsgBox "Kasa No Giriniz", vbCritical, "HATA"
Else

Dim son As Long, deg, i As Long, durum As Boolean, j As Integer, dongu As Integer, durum2 As Boolean
Dim a As Long

For a = ListBox1.ListCount - 1 To 0 Step -1
Dim say7 As Long
say7 = sevkedilen.Cells(65536, 1).End(xlUp).Row + 1
son = Cells(Rows.Count, "B").End(xlUp).Row
deg = Array(ListBox1.List(a))

Application.ScreenUpdating = False

For i = son To 2 Step -1

durum = False
   
For j = 0 To UBound(deg)
            If Cells(i, "B") Like deg(j) Then durum = True
            If durum = True Then Exit For
        Next j

     durum2 = True
   

   
    Dim alan7 As Range
    kesilen.Activate
    Set alan7 = kesilen.Range(kesilen.Cells(i, "B"), kesilen.Cells(i, "J")).SpecialCells(xlCellTypeConstants)
    alan7.Select
    Selection.Copy
    sevkedilen.Activate
    sevkedilen.Cells(say7, "B").PasteSpecial xlPasteValues
    Application.CutCopyMode = True
    kesilen.Activate
    If durum = True Then Rows(i).Delete Shift:=xlUp
    Application.ScreenUpdating = True




Next i
Next a
End If
If durum2 = True Then
ListBox1.Clear
MsgBox "Sevk işlemi başarılı", vbInformation, "BİLGİ"
End If

End Sub
Kullanıcı avatarı
bilgeman
 
Adı Soyadı:Mümin Soybelli
Kayıt: 18 Tem 2013 12:44
İleti: 2
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Bursa


Forum TextBox

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe