Listboxta veri seçme çıkartma taşıma işlemi

Çözüldü Listboxta veri seçme çıkartma taşıma işlemi

  • Konuyu başlatan Konuyu başlatan rasit
  • Başlangıç tarihi Başlangıç tarihi
R

rasit

Normal Üye
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
satissss.webp

Herkese iyi günler dilerim 2 gündür beceremedim bir çok şey denedim sizden rica etsem
1-Çıkart düğmesine basınca seçtiğim ürünü değil en alttakini siliyor onu nasıl yapabilirim ?
2-stoki verileri yansıtacağım 4 nolu bölgedeki listbox ta arama yapmak istiyorum mesela musluk yazınca içinde musluk olan herşey görünsün ve seçip 3 nolu işaretli ekle butonuna basınca sepete eklesin. Birsürü listeleme şekli denedim beceremedim.
 

Ekli dosyalar

Moderatörün son düzenlenenleri:
Tarihe göre sırala Oylamaya göre sırala
@rasit

Önce bir rica: eklediğiniz örnek belgelerde, Application.Visible = False gibi kodları geçici olarak pasif hale getirirseniz iyi olur.
Örnek belge özellikleriyle ilgili diğer açıklamalar, cevabımın altındaki İMZA bölümünde var.

Kodlarınızda dikkatimi çeken ilk şey, satır döngülerinin tümünü 2 To 100.000 şeklinde kurup,
ilk boş satıra denk gelindiğinde ise döngüden çıkılması öngörülmüş.

Oysa ille de döngü kullanılacaksa; döngüyü 2'nci satırdan başlatıp, son dolu satıra kadar diye kurmak daha doğru olur.
Örneğin STOK sayfası için son dolu satır şöyle bulunabilir. sonsatir = Thisworkbook.Sheets("STOK").Cells(Rows.Count,1).End(3).Row

Userformdaki lstsepet nesnesi için; UserForm_Layout kodunda (bence doğrusu Initalize olayını kullanmak ama tercihe bir şey diyemem)
döngüyü hiç yazmadan kırmızı satırların yerine sadece yeşil olanlar yazılabilir.

VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(10 satır)

ÇIKART düğmesiyle ilgili olarak; kırmızı satırları çıkartıp, yeşil olanları eklemeniz yeterlidir.

VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(19 satır)

Arama olayına, başka arkadaşımız ilgilenmezse daha sonra bakayım.
Ancak ARAMA KRİTERİ konusunu açıklarsanız iyi olur.
Sanırım arama STOK sayfasında yapılacak ancak ARAMA SÜTUNU konusunu netleştirirseniz iyi olur.

.

.
 
Oyla 0 Olumsuz oyla
Ricanızı dikkate alacağım. Önerileriniz için çok teşekkürler fakat yazılımcı değilim pandemi de iflas eden bir esnafım yeni bir iş yeri açtım programcılar çok para istediği için kendim yazmak zorunda kaldım. Dolayısı ile kafam bazı şeyleri almıyor mesela

sonsatir = Thisworkbook.Sheets("STOK").Cells(Rows.Count,1).End(3).Row
yazdığımda son dolu satırı buluyor peki son boşu nasıl bulacağım veya
Sheets("SEPET").Range("A" & x - 1).Value = "" gibi alt satıra nasıl işleyeceğim anlayamıyorum :) Proje inceleyerek kopyala yapıştır yöntemi ile bir şeyler yaptım . Aynı şekilde layout u bir videoda gördüm instalize ile farkını hiç bilmiyorum :D

yardımınız için çok teşekkür ederim bunları ekleyeyim :)
 
Oyla 0 Olumsuz oyla
Ömer BARAN' Alıntı:
@rasit

Önce bir rica: eklediğiniz örnek belgelerde, Application.Visible = False gibi kodları geçici olarak pasif hale getirirseniz iyi olur.
Örnek belge özellikleriyle ilgili diğer açıklamalar, cevabımın altındaki İMZA bölümünde var.

Kodlarınızda dikkatimi çeken ilk şey, satır döngülerinin tümünü 2 To 100.000 şeklinde kurup,
ilk boş satıra denk gelindiğinde ise döngüden çıkılması öngörülmüş.

Oysa ille de döngü kullanılacaksa; döngüyü 2'nci satırdan başlatıp, son dolu satıra kadar diye kurmak daha doğru olur.
Örneğin STOK sayfası için son dolu satır şöyle bulunabilir. sonsatir = Thisworkbook.Sheets("STOK").Cells(Rows.Count,1).End(3).Row

Userformdaki lstsepet nesnesi için; UserForm_Layout kodunda (bence doğrusu Initalize olayını kullanmak ama tercihe bir şey diyemem)
döngüyü hiç yazmadan kırmızı satırların yerine sadece yeşil olanlar yazılabilir.

VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(10 satır)

ÇIKART düğmesiyle ilgili olarak; kırmızı satırları çıkartıp, yeşil olanları eklemeniz yeterlidir.

VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(19 satır)

Arama olayına, başka arkadaşımız ilgilenmezse daha sonra bakayım.
Ancak ARAMA KRİTERİ konusunu açıklarsanız iyi olur.
Sanırım arama STOK sayfasında yapılacak ancak ARAMA SÜTUNU konusunu netleştirirseniz iyi olur.

.

.
Genişletmek için tıklayın ...
misal ; yazmış olduğunuz kodda ki kırmızı ile belirttiğim +2 nin ne işe yaradığını anlarsam sepete ekle düğmesinde kullanabilirim bu kodu :)
If lstsepet.ListIndex < 0 Then Exit Sub
sepetsatir = lstsepet.ListIndex + 2
ThisWorkbook.Sheets("SEPET").Range("A" & sepetsatir & ":G" & sepetsatir).Delete Shift:=xlUp
UserForm_Layout
 
Oyla 0 Olumsuz oyla
rasit' Alıntı:
Dolayısı ile kafam bazı şeyleri almıyor mesela
sonsatir = Thisworkbook.Sheets("STOK").Cells(Rows.Count,1).End(3).Row
yazdığımda son dolu satırı buluyor peki son boşu nasıl bulacağım veya
Sheets("SEPET").Range("A" & x - 1).Value = "" gibi alt satıra nasıl işleyeceğim anlayamıyorum :)
Genişletmek için tıklayın ...

@rasit
1) Son Dolu Hücre - İlk Boş Hücre
sonsatir = Thisworkbook.Sheets("STOK").Cells(Rows.Count,1).End(3).Row
bu satırın anlamı tam olarak şöyle:
-- son dolu satır kontrolü A sütununa göre yapılıyor >> Cells(Rows.Count,1) >> 1 numaralı sütun.
-- Cells(Rows.Count,1).End(3).Row >> A sütununda son hücreye (excel versiyonuna göre A1048576 veya A65536 hücresi)
gidip CTRL+YUKARI OK tuşuna basma işleminin VBA karşılığıdır. Son hücreyi seçip elle CTRL+YUKARI OK tuşuna basarak sonucu görün.
Bu işlem sizi A sütununda aşağıdan YUKARI DOĞRU İLK DOLU HÜCREye götürür, .End(3).Row kısmı bu işte.

Bu durumda; ilk boş hücre yukarıda bulunan hücrenin bir altındaki hücre olduğuna göre yukarıdaki kodun sonuna +1 eklenmesi yeterli demektir.
Kodda sonsatir = ..... satırı varsa ilkboshucre = sonsatir + 1 olur.
Kodda sonsatir = ..... satırı yoksa ilkboshucre = Cells(Rows.Count,1).End(3).Row + 1 olur.

2) Koddaki +2 ne anlama geliyor?
rasit' Alıntı:
misal ; yazmış olduğunuz kodda ki kırmızı ile belirttiğim +2 nin ne işe yaradığını anlarsam sepete ekle düğmesinde kullanabilirim bu kodu :)
If lstsepet.ListIndex < 0 Then Exit Sub
sepetsatir = lstsepet.ListIndex + 2
ThisWorkbook.Sheets("SEPET").Range("A" & sepetsatir & ":G" & sepetsatir).Delete Shift:=xlUp
UserForm_Layout
Genişletmek için tıklayın ...

-- Listbox nesnesinin ilk satırının index değeri 0 'dır ve sonraki satırlarda 1'er artarak devam eder.
Bu nedenle önce; eğer listboxta hiçbir satır seçili değilse bu index değeri -1 olur.
If lstsepet.ListIndex < 0 Then Exit Sub >> Iistboxta seçim yapılmamışsa İŞLEM YAPMADAN ÇIK demişim.

-- Bu listboxun kaynağı SEPET sayfası olduğuna, başlık satırı listboxa dahil edilmediğine (+1)
ve listboxta index değerleri 0'dan başladığına (+1) göre;
listboxta seçilen bir satırın SEPET sayfasındaki SATIR NUMARASI karşılığı Listbox.ListIndex + 2 demektir.
sepetsatir = lstsepet.ListIndex + 2 ile ÇIKARTılacak satır numarası tespit edildiğine göre;
ThisWorkbook.Sheets("SEPET").Range("A" & sepetsatir & ":G" & sepetsatir).Delete Shift:=xlUp şeklinde bu satır silinir.

Kolay gelsin.
 
Oyla 0 Olumsuz oyla
Merhabalar Sn. @rasit
Arama işlemi için bir örnek paylaşayım.
*** Dosyanızda Stok_Arama isimli bir sayfa oluşturdum.

İşlem sırası şu şekilde.
-- TextBox' a yazdığınız ürün isimleri Stok sayfasında aranır ve bulunan kayıtlar Stok_Arama sayfasına aktarılır.
-- Stok_Arama sayfasındaki kayıtlar ListBox1'e RowSource özelliği ile aktarılır.
-- ListBox1' de seçtiğiniz ürün bilgileri ilgili TextBox'lara aktarılır.
-- Iskonto ve Adet bilgilerini girdikten sonra SEPETE_EKLE kodlarını çalıştırdığınız için Sepete Ekle düğmesine gerek yok bence.
* Sepete Ekleme işlemi Ekle düğmesi ile de yapılmakta.
 

Ekli dosyalar

Oyla 0 Olumsuz oyla
Ömer BARAN' Alıntı:
@rasit
1) Son Dolu Hücre - İlk Boş Hücre
sonsatir = Thisworkbook.Sheets("STOK").Cells(Rows.Count,1).End(3).Row
bu satırın anlamı tam olarak şöyle:
-- son dolu satır kontrolü A sütununa göre yapılıyor >> Cells(Rows.Count,1) >> 1 numaralı sütun.
-- Cells(Rows.Count,1).End(3).Row >> A sütununda son hücreye (excel versiyonuna göre A1048576 veya A65536 hücresi)
gidip CTRL+YUKARI OK tuşuna basma işleminin VBA karşılığıdır. Son hücreyi seçip elle CTRL+YUKARI OK tuşuna basarak sonucu görün.
Bu işlem sizi A sütununda aşağıdan YUKARI DOĞRU İLK DOLU HÜCREye götürür, .End(3).Row kısmı bu işte.

Bu durumda; ilk boş hücre yukarıda bulunan hücrenin bir altındaki hücre olduğuna göre yukarıdaki kodun sonuna +1 eklenmesi yeterli demektir.
Kodda sonsatir = ..... satırı varsa ilkboshucre = sonsatir + 1 olur.
Kodda sonsatir = ..... satırı yoksa ilkboshucre = Cells(Rows.Count,1).End(3).Row + 1 olur.

2) Koddaki +2 ne anlama geliyor?


-- Listbox nesnesinin ilk satırının index değeri 0 'dır ve sonraki satırlarda 1'er artarak devam eder.
Bu nedenle önce; eğer listboxta hiçbir satır seçili değilse bu index değeri -1 olur.
If lstsepet.ListIndex < 0 Then Exit Sub >> Iistboxta seçim yapılmamışsa İŞLEM YAPMADAN ÇIK demişim.

-- Bu listboxun kaynağı SEPET sayfası olduğuna, başlık satırı listboxa dahil edilmediğine (+1)
ve listboxta index değerleri 0'dan başladığına (+1) göre;
listboxta seçilen bir satırın SEPET sayfasındaki SATIR NUMARASI karşılığı Listbox.ListIndex + 2 demektir.
sepetsatir = lstsepet.ListIndex + 2 ile ÇIKARTılacak satır numarası tespit edildiğine göre;
ThisWorkbook.Sheets("SEPET").Range("A" & sepetsatir & ":G" & sepetsatir).Delete Shift:=xlUp şeklinde bu satır silinir.

Kolay gelsin.
Genişletmek için tıklayın ...
çok teşekkür ediyorum her şeyi çok net anladım hatta sepete ekle butonunu sizin verdiğiniz kodlarla başardım
If lststok.ListIndex < 0 Then Exit Sub
sepetsatir = lststok.ListIndex + 2
txtbarkod.Value = ThisWorkbook.Sheets("STOK").Range("A" & sepetsatir).Value
URUN_BUL
şeklinde çevirdim :)

arama hususuna gelince bir çok araştırma yaptım bana lazım olan kodu buldum fakat çalıştıramadım

Private Sub TextBox1_Change()
On Error Resume Next
lststok.Clear

aranan = TextBox1.Text

sonsatir = Sheets("STOK").Cells(Rows.Count, "B").End(xlUp).Row
ReDim dizi(sonsatir) As Variant

x = 0
For i = 1 To sonsatir - 1
If Sheets("STOK").Cells(i, 1) Like "*" & aranan & "*" Then
dizi(x) = Sheets("STOK").Cells(i, 1)
x = x + 1
End If
Next i
ReDim Preserve dizi(x - 1)
lststok.List = dizi

End Sub

bunu denedim çalıştıramıyorum
 
Oyla 0 Olumsuz oyla
AhmetRasim' Alıntı:
Merhabalar Sn. @rasit
Arama işlemi için bir örnek paylaşayım.
*** Dosyanızda Stok_Arama isimli bir sayfa oluşturdum.

İşlem sırası şu şekilde.
-- TextBox' a yazdığınız ürün isimleri Stok sayfasında aranır ve bulunan kayıtlar Stok_Arama sayfasına aktarılır.
-- Stok_Arama sayfasındaki kayıtlar ListBox1'e RowSource özelliği ile aktarılır.
-- ListBox1' de seçtiğiniz ürün bilgileri ilgili TextBox'lara aktarılır.
-- Iskonto ve Adet bilgilerini girdikten sonra SEPETE_EKLE kodlarını çalıştırdığınız için Sepete Ekle düğmesine gerek yok bence.
* Sepete Ekleme işlemi Ekle düğmesi ile de yapılmakta.
Genişletmek için tıklayın ...
Öncelikle ilgilendiğiniz için çok teşekkür ederim. Malesef dosyayı indiremiyorum.
Private Sub TextBox1_Change()
On Error Resume Next
lststok.Clear

aranan = TextBox1.Text

sonsatir = Sheets("STOK").Cells(Rows.Count, "B").End(xlUp).Row
ReDim dizi(sonsatir) As Variant

x = 0
For i = 1 To sonsatir - 1
If Sheets("STOK").Cells(i, 1) Like "*" & aranan & "*" Then
dizi(x) = Sheets("STOK").Cells(i, 1)
x = x + 1
End If
Next i
ReDim Preserve dizi(x - 1)
lststok.List = dizi

End Sub

bunu denedim malesef çalışmıyor ama ihtiyacım olan arama şekli tam olarak bu musluk yazdığım zaman içerisinde musluk olan herşeyi bulup getircek . Eğer kodu paylaşma imkanınız varsa sayfayı oluşturabilirim
 
Oyla 0 Olumsuz oyla
Merhabalar Sn. @rasit ,
Benim paylaştığım dosya için şu adımları uygulayınız.

-- Stok_Arama isimli bir sayfa oluşturup A - G sütunları arasındaki başlıkları bu sayfaya kopyalayınız.

1632492402823.webp


1632492257907.webp


-- Arama işlemi için aşağıdaki kodları kopyalayınız.
VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(39 satır)

-- Son olarak aşağıdaki kodları da ilgili kodlar ile değiştiriniz.
txtadet_KeyDown kodları
VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(6 satır)

Ekle düğmesinin kodları
VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(4 satır)

*** Güncelleme Notu:
ListBox1_Click kodlarını eklemeyi unutmuşum.
-- Arama sonucu listelenen kayıtları TextBox'lara aktarmak için aşağıdaki kodları kullanabilirsiniz.
VBA: 
Görüntülemek için giriş yapmanız gerekmektedir.
(7 satır)
 
Moderatörün son düzenlenenleri:
Oyla 0 Olumsuz oyla
AhmetRasim' Alıntı:
Merhabalar Sn. @rasit
Rica ederim.
Bir önceki mesajda ListBox1_Click kodlarını eklemeyi unutmuşum, bu nedenle mesajı güncelledim.
Saygılarımla, iyi çalışmalar.
Genişletmek için tıklayın ...
teşekkürler onu
If lstsepet.ListIndex < 0 Then Exit Sub
sepetsatir = lstsepet.ListIndex + 2
ThisWorkbook.Sheets("SEPET").Range("A" & sepetsatir & ":G" & sepetsatir).Delete Shift:=xlUp
UserForm_Layout
kodunu yontarak hallettim :) tıklatınca A rangesindeki barkoda yazıyor sonra ürünbul fonksiyonunu çalıştırıyor ilginiz için çok teşekkürler :)
 
Oyla 0 Olumsuz oyla
Yanıt için giriş yapmanız veya üye olmanız gerekir.
Üst