Tablodan İhtiyaç Listesi oluşturma

[Cumas]

İyi Günler,
Bir tablomuz var. bu tabloya gerekli olan malzemelerimizi giriyoruz. İstediğim bu tabloya girilmiş olan malzemelerin sınıflandırılarak sayılarının çıkarılması.
Dosya yüklüyorum. Gerekli açıklamalar excel dosyasında vardır.
Şimdiden teşekkür ederim ve kolaylıklar dilerim.

 

[yanginci34]

Dosya göremedim ?

 

[Cumas]

Yanlışlık yapmışım. anlayınca hemen sildim. düzeltmeleri yaptım ve yükledim.

 

[Cumas]

İyi günler. Uzun süre geçti. Hiç cevap yok. Acaba böyle bir şey mümkün değil mi. Yapabilen varsa yaparsa çok memnun kalacağım. Bir zahmet bilen arkadaşlar ilgilenebilir mi.
Teşekkür ederim.

 

[Cumas]

İyi akşamlar.
Çoktandır sorunumu buraya yazdım ama hiç cevap çıkmadı.
Acaba gözden kaçmış olabilir mi?
Rica ediyorum. Hiç olmazsa bir görüş belirtin. Böyle bir şey olur mu olmaz mı? Onu da tam olarak bilmiyorum.
Gerekli oldu. çok sayıda kayıt girip sipariş listesi oluşturmak için düşünülmüş.
Fikri olanlar, bilenler yardımcı olur sorunumuzu çözerse çok büyük bir yükten kurtulacağım.
Şimdiden teşekkür eder kolaylıklar dilerim.

 

[netzone]

Merhaba @Cumas,

Sorunuzu özetlemek gerekirse: C sütunundan BB sütununa kadar olan alanda Komponent Listesinde yer alan Kapasitör, IC, Resistor kaç adet bulunuyor bunları yanına yazmak istiyorsunuz.

Örnek dosyanızda > Komponent Listesi sayfanızın C3 hücresine şu formülü uygulayın. =EĞERSAY(Devreler!$C:$BB;B3) akabinde formül girilmiş hücreyi diğer alanlara çoğaltın. Kontrol edin.

*B10 da yer alan 0,01uF tablonuzda yer almıyor bilginize.

İyi çalışmalar.

 

[Korhan Ayhan]

X sütunundan sonraki verilerde listelenecek mi?

 

[Cumas]

Evet

 

[Cumas]

Merhaba @Cumas,

Sorunuzu özetlemek gerekirse: C sütunundan BB sütununa kadar olan alanda Komponent Listesinde yer alan Kapasitör, IC, Resistor kaç adet bulunuyor bunları yanına yazmak istiyorsunuz.

Örnek dosyanızda > Komponent Listesi sayfanızın C3 hücresine şu formülü uygulayın. =EĞERSAY(Devreler!$C:$BB;B3) akabinde formül girilmiş hücreyi diğer alanlara çoğaltın. Kontrol edin.

*B10 da yer alan 0,01uF tablonuzda yer almıyor bilginize.

İyi çalışmalar.

Sayın netzone ilginiz için teşekkür ederim. Formülünüzü yazdım; denedim. Sadece sayıları yazıyor. Ben tablodaki komponentlerin bir listesini oluşturmasını ve de bu komponentlerin sayısının (Yani tabloya kaç kere yazılmış) karşısına yazan bir çözüm arıyorum. B sütununda Kapasitör başlığı altındaki liste elle yazılmayacak. Bu listede formül yada makro ile excel yazacak.
kontrol ettim. Evet B!0 hücresinde yazılan 0,01uf kapasitörü Devreler tablosunda yok. Onu düzelteceğim.

 

[Cumas]

X sütunundan sonraki verilerde listelenecek mi?

Korhan bey evet. tablonun tamamında bulunan malzemeleri listeleyecek.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Alan As Range, Satir As Long, Sutun As Byte, Veri As Variant
    Dim X As Long, Y As Byte, Z As Integer, Liste As Variant
    Dim Say As Long, Son As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Devreler")
    Set S2 = Sheets("Komponent Listesi")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    S2.Cells.Clear
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    
    ReDim Liste(1 To 1, 1 To 26)
    
    X = 1
    Say = 1
        
    For Each Alan In S1.Range("C3:BB3")
        If Alan.Cells(1, 1) <> "" Then
            Liste(Say, X) = Alan.Cells(1, 1).Value
            Liste(Say, X + 1) = "Adet"
            X = X + 2
        End If
    Next
    
    S2.Range("B2").Resize(1, 26) = Liste
    S2.Range("B2").Resize(1, 26).Font.Bold = True
    
    ReDim Liste(1 To Son * S1.Range("C3:BB3").Columns.Count, 1 To 2)
    
    Veri = Array(S1.Range("C4:G" & Son).Value, S1.Range("H4:M" & Son).Value, S1.Range("N4:W" & Son).Value, _
                 S1.Range("X4:Y" & Son).Value, S1.Range("Z4:Ad" & Son).Value, S1.Range("AE4:AG" & Son).Value, _
                 S1.Range("AH4:AL" & Son).Value, S1.Range("AM4:AP" & Son).Value, S1.Range("AQ4:AQ" & Son).Value, _
                 S1.Range("AR4:AS" & Son).Value, S1.Range("AT4:AX" & Son).Value, S1.Range("AY4:AZ" & Son).Value, S1.Range("BA4:BB" & Son).Value)
    
    For X = LBound(Veri) To UBound(Veri)
        Say = 0
        Sutun = Sutun + 2
        Dizi.RemoveAll
        For Y = 1 To UBound(Veri(X), 2)
            For Z = 1 To UBound(Veri(X), 1)
                If Veri(X)(Z, Y) <> "" Then
                    If Not Dizi.Exists(Veri(X)(Z, Y)) Then
                        Say = Say + 1
                        Dizi.Add Veri(X)(Z, Y), Say
                        Liste(Say, 1) = Veri(X)(Z, Y)
                        Liste(Say, 2) = 1
                    Else
                        Liste(Dizi.Item(Veri(X)(Z, Y)), 2) = Liste(Dizi.Item(Veri(X)(Z, Y)), 2) + 1
                    End If
                End If
            Next
        Next
        If Say > 0 Then S2.Cells(3, Sutun).Resize(Say, 2) = Liste
    Next
    
    S2.Columns.AutoFit
    S2.Select
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[çıtır]

Formülle oluşturulmuş çözüm;Dosyanız.

 

[Cumas]

Çok çok teşekkür ederim Korhan Bey.
Elinize emeğinize sağlık.
Kodu aldım dosyama yapıştırdım ekledim. Makroyu çalıştırdım.
Doğru çalışıyor. Denemeler yaptım. kayıtlar ekledim, sildim. Doğru çalışıyor. Çok güzel.
Devreler tablosunda sağ tarafa yeni komponentler eklediğimde ise kodlarda gerekli değişiklikleri
(deneme yanılma yoluyla öğrendikten sonra) yaparak listeye bu komponentin de adı ve adetlerinin
eklenmesini sağladım. Tablonun aşağı doğru uzamasında hiç sorun yok; 100'lerce satır kayıtlarla
deneme yaptım doğru çalışıyor.
Tekrar teşekkür ederim.

 

[Cumas]

İyi Günler Çıtır Bey,
İlginiz ve çabanız için çok teşekkür ederim.
Elinize emeğinize sağlık
Çözümü inceledim. denemeler yaptım. Devreler tablosuna yeni komponentler ekledikten sonra formüllerde gerekli değişiklikler yapmayı da öğrendim.
Korhan Bey, makro ile çözmüş sizin formüllerle yapmanız benim için bir alternatif oldu.
Çok çok teşekkür ederim.

 

[çıtır]

İyi Günler Çıtır Bey,
İlginiz ve çabanız için çok teşekkür ederim.
Elinize emeğinize sağlık
Çözümü inceledim. denemeler yaptım. Devreler tablosuna yeni komponentler ekledikten sonra formüllerde gerekli değişiklikler yapmayı da öğrendim.
Korhan Bey, makro ile çözmüş sizin formüllerle yapmanız benim için bir alternatif oldu.
Çok çok teşekkür ederim.

Rica ederim.Dönüş yaptığınız için teşekkür ederim.