• DİKKAT

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

2 Combobox ile listvieve süzme için yardım

E

erkanselek

Katılım
4 Şubat 2012
Mesajlar
32
Excel Vers. ve Dili
Ofice2003
Türkçe
Selam üstadlar
Bu siteden aldığım bir programda değişiklikler yaptım ve kendime uyarladım biraz takıldığım bir durum var girdiğim ürünleri gerektiğinde yazdıra bilmek için 2 şık ile süzme yapmak istiyorum Makine no ve sipariş numarasına göre

Yardımcı olabilirseniz çok sevinirim

Dosya ekte
 
Son düzenleme:
erkanselek' Alıntı:
Selam üstadlar
Bu siteden aldığım bir programda değişiklikler yaptım ve kendime uyarladım biraz takıldığım bir durum var girdiğim ürünleri gerektiğinde yazdıra bilmek için 2 şık ile süzme yapmak istiyorum Makine no ve sipariş numarasına göre

Yardımcı olabilirseniz çok sevinirim

Dosya ekte
Genişletmek için tıkla ...

Eki incelermisiniz.
 

Ekli dosyalar

Sayın Husgvarna ilginize çok teşekkürler
Konuyu ilk açtığımda eksik açıklamışım
Ekteki dosyada Armür 5 olan makinaya değişik sipariş nolu ürünler girdim Armür 5 i süzdükten sonra Armür5 deki aynı sipariş nolu ürünleri listelemem gerekmekte mümkünmüdür?
Birde süzme işlemi sonrasını oraya bir text box koyup alt toplam alabilirmi...
 

Ekli dosyalar

Son düzenleme:
erkanselek' Alıntı:
Sayın Husgvarna ilginize çok teşekkürler
Konuyu ilk açtığımda eksik açıklamışım
Ekteki dosyada Armür 5 olan makinaya değişik sipariş nolu ürünler girdim Armür 5 i süzdükten sonra Armür5 deki aynı sipariş nolu ürünleri listelemem gerekmekte mümkünmüdür?
Birde süzme işlemi sonrasını oraya bir text box koyup alt toplam alabilirmi...
Genişletmek için tıkla ...
Aşağıdaki kodlar isteğiniz için yeterlidir sanırm "yazdırılacak" adlı sayfaya eklediğiniz başlığa; verileri formüllerlemi alacaksınız ?
Kod: 
 Private Sub ComboBox3_Change()
If ComboBox3 = "" Then Exit Sub
Sheets("yazdırılacak").[A6:T65000] = Empty
ListView1.ListItems.Clear
For a = 2 To Sheets("DATA").Cells(65000, 1).End(xlUp).Row
If Sheets("DATA").Cells(a, "b") = ComboBox3 Then
b = Sheets("yazdırılacak").Cells(65000, 1).End(xlUp).Row
Sheets("yazdırılacak").Range("a" & b + 1 & ":t" & b + 1).Value = Sheets("DATA").Range("a" & a & ":t" & a).Value
ListView1.ListItems.Add , , Cells(a, 1).Value
y = ListView1.ListItems.Count
For c = 2 To 19
ListView1.ListItems(y).ListSubItems.Add , , Cells(a, c).Value
Next
End If
Next
End Sub
Private Sub ComboBox4_Change()
If ComboBox4 = "" And ComboBox3 = "" Then Exit Sub
If ComboBox3 = "" Then Exit Sub
Sheets("yazdırılacak").[A6:T65000] = Empty
ListView1.ListItems.Clear
For a = 2 To Sheets("DATA").Cells(65000, 1).End(xlUp).Row
If Sheets("DATA").Cells(a, "b") & Sheets("DATA").Cells(a, "c") = ComboBox3 & ComboBox4 Then
b = Sheets("yazdırılacak").Cells(65000, 1).End(xlUp).Row
Sheets("yazdırılacak").Range("a" & b + 1 & ":t" & b + 1).Value = Sheets("DATA").Range("a" & a & ":t" & a).Value
ListView1.ListItems.Add , , Cells(a, 1).Value
y = ListView1.ListItems.Count
For c = 2 To 19
ListView1.ListItems(y).ListSubItems.Add , , Cells(a, c).Value
Next
 End If
 Next

End Sub
 
Son düzenleme:
Ellerine Sağlık hocam bende 2 combobox daha ekleyip tam tersi işlemide ekledim çok güzel oldu

Süzülenleri alt toplam olarak bir textboxa veya nasıl yapılabilirse ekleme şansımız olabilirmi

Başkalarına yardımı olabilirse diye son halini ekliyorum

Tekrar tekrar Teşekürler....
 
Son düzenleme:
erkanselek' Alıntı:
Adet ve Kiloları toplayacağız
Genişletmek için tıkla ...

Aşağıdaki kodlarda bulunan kırmızı bölümleri ekleyin.
Kod: 
Private Sub ComboBox4_Change()
If ComboBox4 = "" And ComboBox3 = "" Then Exit Sub
If ComboBox3 = "" Then Exit Sub
Sheets("yazdırılacak").[A6:T65000] = Empty
ListView1.ListItems.Clear
For a = 2 To Sheets("DATA").Cells(65000, 1).End(xlUp).Row
If Sheets("DATA").Cells(a, "b") & Sheets("DATA").Cells(a, "c") = ComboBox3 & ComboBox4 Then
b = Sheets("yazdırılacak").Cells(65000, 1).End(xlUp).Row
Sheets("yazdırılacak").Range("a" & b + 1 & ":t" & b + 1).Value = Sheets("DATA").Range("a" & a & ":t" & a).Value
ListView1.ListItems.Add , , Cells(a, 1).Value
y = ListView1.ListItems.Count
For c = 2 To 19
ListView1.ListItems(y).ListSubItems.Add , , Cells(a, c).Value
aa = aa + Cells(a, 8)
Next
 End If
 Next
[COLOR="Red"]TextBox61 = 0
TextBox62 = 0
 For a = 1 To ListView1.ListItems.Count
 TextBox61 = Format(TextBox61 + CDbl(ListView1.ListItems(a).ListSubItems(7).Text), "##,##.00")
 TextBox62 = Format(TextBox62 + CDbl(ListView1.ListItems(a).ListSubItems(8).Text), "##,##.00")
Next[/COLOR]

MsgBox "seçtiğiniz makina noya göre yazdırılacak sayfasına aktarım yapıldı"
End Sub
 
Çok teşekkürler Husgvarna Hocam elinize sağlık çok güzel çalışıyor...

Yeni eklemeler yapmayı düşünüyorum yapabildiğim kadar yapmaya çalışacağım son halini burada paylaşacağım ve yardımlarınız olursa sevinirim...

bu yapılabildiklerimin tamamı bu site ve sizin sayenizde sonsuz teşekkürler tekrardan...
 
Husgvarna hocam her makine bir sayfa ve user form açarak bu sorunu çözebilirim diye düşündüm ama listviev son kaydederkenki aktif sayfayı listeliyor ekteki ana userformda tıkladığım makine nosunu listeletebilirmiyiz? yeni kayıtı da userformunadı ile aynı syfaya kayıt yapacağız çıkış yaptığımızdada exceli kapatmak yerine ana menüyü etkinleştireceğiz olabilirmi?
 
Son düzenleme:

Ekli dosyalar

erkanselek' Alıntı:
Bazı değişiklikler ve özellik azaltımı yaptım ListBox yerine butonlar ile sayfalara gitme şansımız olabilirmi ana menüyede siparişleri listvievledim

Çok teşekkürler bu hali bile yeterli ama yapılabilirliği varsa daha iyi olacak...
Genişletmek için tıkla ...
Merhaba.
Bir önceki dosyanızdaki gibi her sayfa için bir buton oluşturup her butona

Kod: 
Private Sub CommandButton[COLOR="Red"]1[/COLOR]_Click()
Sheets("[COLOR="#ff0000"]ARMÜR1[/COLOR]").Select
Unload Me
UserForm1.Show
End Sub
kodlarını ayrı ayrı butonlara uyarlamanız gerekli.
 
Husgvarna' Alıntı:
Merhaba.
Bir önceki dosyanızdaki gibi her sayfa için bir buton oluşturup her butona

Kod: 
Private Sub CommandButton[COLOR="Red"]1[/COLOR]_Click()
Sheets("[COLOR="#ff0000"]ARMÜR1[/COLOR]").Select
Unload Me
UserForm1.Show
End Sub
kodlarını ayrı ayrı butonlara uyarlamanız gerekli.
Genişletmek için tıkla ...


Teşekkürler Hocam sayenizde geldiğim nokta ektedir...
 

Ekli dosyalar

Husgvarna Hocam Ana menüdeki listviev e siparişler dosyasındaki bazı sütünları almak istiyotum sıralı olarak hepsini değilde örneğin C D G H gibi sütünları gene yaklaşık 19 sütün olacak bunu nasıl yapabilirim
Umarım sizi çok yormuyorumdur herkeze yardımcı oluyorsunuz onun verdiği rahatlıkla sürekli talepte bulunuyorum rahatsızlık veriyorsam özür dilerim
 
erkanselek' Alıntı:
Husgvarna Hocam Ana menüdeki listviev e siparişler dosyasındaki bazı sütünları almak istiyotum sıralı olarak hepsini değilde örneğin C D G H gibi sütünları gene yaklaşık 19 sütün olacak bunu nasıl yapabilirim
Genişletmek için tıkla ...
Merhaba.
Almak istedğiniz sütunları yazarmısınız?
 
erkanselek' Alıntı:
Merhaba hocam

Almayı istediğim sütunlar
C-D-E-F-J-K-L-M-N-O-P-Q-S-T-U-V-W-X-Y-Z
Genişletmek için tıkla ...
Merhaba.
"ANAMENÜ" Formunun kod sayfasındaki "UserForm_Initialize" bölümünü aşağıdaki gibi değiştirip deneyin.

Kod: 
Private Sub UserForm_Initialize()
Sheets("SİPARİŞLER").Select
Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = Application.Width
Y1 = Application.Height
X2 = Me.Width
Y2 = Me.Height
CX = X1 / X2
CY = Y1 / Y2
Me.Width = X1
Me.Height = Y1
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
ListView1.View = lvwReport
ListView1.Gridlines = True
ListView1.FullRowSelect = True
ListView1.ListItems.Clear
ListView1.ColumnHeaders.Clear
With ListView1.ColumnHeaders
.Add , , "SİP.NO", 40
.Add , , "FİRMA", 40
.Add , , "EN", 40
.Add , , "BOY", 40
.Add , , "DESEN", 70
.Add , , "DESEN ADI/RENK", 40
.Add , , "HAV", 40
.Add , , "GRAM M2", 40
.Add , , "İSTENEN AD.", 40
.Add , , "DOKUNAN AD.", 40
.Add , , "KALAN AD.", 40
.Add , , "SONUÇ", 40
.Add , , "FİRMA", 40
.Add , , "BOYANACAK RENK", 40
.Add , , "BEZ", 40
.Add , , "KAPAMALAR", 40
.Add , , "UÇ BORDÜRLER", 90
.Add , , "KISA HAVLAR", 40
.Add , , "BORDÜRLER", 40
.Add , , "TOPLAM BOY", 40

End With
For s = 3 To Cells(65530, 1).End(xlUp).Row
ListView1.ListItems.Add , , Cells(s, 3).Value
y = ListView1.ListItems.Count
For a = 4 To 26
If a = 7 Then a = 10
If a = 18 Then a = 19
ListView1.ListItems(y).ListSubItems.Add , , Cells(s, a).Value
Next
Next
End Sub
 
Husgvarna' Alıntı:
Merhaba.
"ANAMENÜ" Formunun kod sayfasındaki "UserForm_Initialize" bölümünü aşağıdaki gibi değiştirip deneyin.

Kod: 
Private Sub UserForm_Initialize()
Sheets("SİPARİŞLER").Select
Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = Application.Width
Y1 = Application.Height
X2 = Me.Width
Y2 = Me.Height
CX = X1 / X2
CY = Y1 / Y2
Me.Width = X1
Me.Height = Y1
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
ListView1.View = lvwReport
ListView1.Gridlines = True
ListView1.FullRowSelect = True
ListView1.ListItems.Clear
ListView1.ColumnHeaders.Clear
With ListView1.ColumnHeaders
.Add , , "SİP.NO", 40
.Add , , "FİRMA", 40
.Add , , "EN", 40
.Add , , "BOY", 40
.Add , , "DESEN", 70
.Add , , "DESEN ADI/RENK", 40
.Add , , "HAV", 40
.Add , , "GRAM M2", 40
.Add , , "İSTENEN AD.", 40
.Add , , "DOKUNAN AD.", 40
.Add , , "KALAN AD.", 40
.Add , , "SONUÇ", 40
.Add , , "FİRMA", 40
.Add , , "BOYANACAK RENK", 40
.Add , , "BEZ", 40
.Add , , "KAPAMALAR", 40
.Add , , "UÇ BORDÜRLER", 90
.Add , , "KISA HAVLAR", 40
.Add , , "BORDÜRLER", 40
.Add , , "TOPLAM BOY", 40

End With
For s = 3 To Cells(65530, 1).End(xlUp).Row
ListView1.ListItems.Add , , Cells(s, 3).Value
y = ListView1.ListItems.Count
For a = 4 To 26
If a = 7 Then a = 10
If a = 18 Then a = 19
ListView1.ListItems(y).ListSubItems.Add , , Cells(s, a).Value
Next
Next
End Sub
Genişletmek için tıkla ...


Hocam sonuç verdi ama türkçe karakterleri kabul etmiyor i ü gibi
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst