• DİKKAT

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

Toplam metrajı, sonuç sayfasına aktarma?

A

ayrıca88

Katılım
27 Eylül 2011
Mesajlar
17
Excel Vers. ve Dili
Excel 2003
Merhabalar,

Ekde kesim listesi ve sonuç olmak üzere 2 sayfadan oluşan çalışmam yer almakta.
Kesim listesinde aynı cins ve özelliklere sahıp, farklı tarihlerde girilen malzemelerin toplam metrajını sonuç sayfasına aktarmasını istiyorum.
Ürün adı birim ve toplam metrajı sonuç sayfasına aktarmamız mümkün müdür?

Yardımcı olursanız çok sevinirim.
Şimdiden teşekkürler...
 

Ekli dosyalar

Merhaba,

Bu şekilde deneyin.

=ETOPLA('Kesim Listesi'!$A$3:$A$24;A3;'Kesim Listesi'!$H$3:$H$24)

.
 
Ömer' Alıntı:
Merhaba,

Bu şekilde deneyin.

=ETOPLA('Kesim Listesi'!$A$3:$A$24;A3;'Kesim Listesi'!$H$3:$H$24)

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



Ömer bey çok teşekkür ederim beni büyük bir yükten kurtardınız.

2. olarakta birşey sorsam size; sonuç sayfasına sadece tablo oluştursak cinsini ve birimini yazmasak; kesim listesindeki malzemelerin cinsi ve birimi ile birlikte topraj metrajı, sonuç sayfasına aktarmamız mümkün olur mu?

Teşekkürler..
 
ayrıca88' Alıntı:
Ömer bey çok teşekkür ederim beni büyük bir yükten kurtardınız.

2. olarakta birşey sorsam size; sonuç sayfasına sadece tablo oluştursak cinsini ve birimini yazmasak; kesim listesindeki malzemelerin cinsi ve birimi ile birlikte topraj metrajı, sonuç sayfasına aktarmamız mümkün olur mu?

Teşekkürler..
Genişletmek için tıkla ...

Evet mümkündür. "Kesim Listesi" sayfasında kaç satır veri olabilir? Eğer veri fazla olacaksa makro değilse fonksiyonla yapabiliriz. Yada hangisiyle yapılmasını istiyorsunuz?

.
 
Ömer' Alıntı:
Evet mümkündür. "Kesim Listesi" sayfasında kaç satır veri olabilir? Eğer veri fazla olacaksa makro değilse fonksiyonla yapabiliriz. Yada hangisiyle yapılmasını istiyorsunuz?

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

Satır sayısını çok fazla kestirmem mümkün değil. İşin büyüklüğüne göre değişebiliyor. Ama ortalama 1500-2000 arasında oluyor. Makro ya da fonksiyon hiç farketmez. Hangisi daha kullanışlı olursa tercihimiz odur. Elbetteki siz daha iyi bilirisniz.
Teşekkürler..
 
İki sorum olacak?

1) "Kesim Listesi" H sütunuda BUYUKBUL fonksiyonunu kullanmanızdaki amaç nedir?
2) Sonuç sayfasında Birim fiyatları manuel mi girecekseniz, yoksa bir datanız var mı?

.
 
Ömer' Alıntı:
İki sorum olacak?

1) "Kesim Listesi" H sütunuda BUYUKBUL fonksiyonunu kullanmanızdaki amaç nedir?
2) Sonuç sayfasında Birim fiyatları manuel mi girecekseniz, yoksa bir datanız var mı?

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

Ömer bey,

Birim fiyatların için herhangi bir data yok elle gireceğim.

Büyükbul fonksiyonu ise, şevli ürünlerin ölçülerini yazarken kesin metraj almak için kullanıyorum.
Yani bir taşın sağ tarafı 150cm iken sol tarafı 50 cm olabiliyor. Bizim için önemli olan büyük ölçü. O sebepten toplamda doğabilecek bir eksiklik önlenmiş oluyor.
Biraz karışık oldu ama, Umaranım anlatabilmişimdir.
 
Module kopyalayıp çalıştırın. Sonuc sayfasında 3.satır ve sonraki tüm hücreleri silip yeniden yazar.

Kod: 
Sub Ozet()
 
    Dim s, a1, a2, deg, dizi
    Dim i As Long, d As Object, j As Byte
 
    Application.ScreenUpdating = False
    Sheets("Sonuç").Select
    Range("A3:E" & Rows.Count).Clear
 
    Set d = CreateObject("Scripting.Dictionary")
 
    With Sheets("Kesim Listesi")
        For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(i, "A") <> "" And .Cells(i, "F") <> "" _
                And IsNumeric(.Cells(i, "F")) = True Then
                deg = .Cells(i, "A") & "|" & .Cells(i, "B")
                If Not d.exists(deg) Then
                    s = .Cells(i, "H")
                    d.Add deg, s
                Else
                    s = d.Item(deg)
                    s = s + .Cells(i, "H")
                    d.Item(deg) = s
                End If
            End If
        Next i
    End With
 
    a1 = d.keys: a2 = d.items
 
    For i = 0 To d.Count - 1
        dizi = Split(a1(i), "|")
        For j = 0 To UBound(dizi)
            Cells(i + 3, j + 1) = dizi(j)
        Next j
        s = a2(i)
        Cells(i + 3, "C") = s
        Cells(i + 3, "E") = "=C" & i + 3 & "*D" & i + 3
    Next i
    Cells(i + 3, "E") = "=Sum(E3:E" & i + 2 & ")"
 
End Sub
.
 
Ömer bey emeğinize sağlık çok güzel bir çalışma olmuş gerçekten.

Yalnız modülün sürekli aktif olması için her yeni ölçü eklediğimde, çalıştır yapmam lazım mı yoksa ben mi beceremedim?
 
Kodları butona atayarak işlem yaparsanız daha pratik olacaktır. Dilediğiniz zaman kodu çalıştırırsınız.
 
Ömer' Alıntı:
Kodları butona atayarak işlem yaparsanız daha pratik olacaktır. Dilediğiniz zaman kodu çalıştırırsınız.
Genişletmek için tıkla ...

Butonu da hallettim sayenizde:) Saolasınız.

Birde her güncellemede birim fiyatlar siliniyor. Onların girdiğim gibi kalmasını nasıl sağlayabiliriz? İstediğim zaman değişiklik yapabilmeliyim.
 
Bu mantıkla yapılmasını tavsiye etmem. Bir data sayfası oluşturup ürünleri ve fiyatlarını bu sayfadan almak daha mantıklı olur.
 
Ömer Bey,

Dosyayı ekdeki gibi tabloyla sonuç sayfasının yanına yazsam fiyatları olur mu? Çünkü her işte ayrı fiyatlandırma yapabiliyoruz. Yada 3. bir sayfa mı açmalıyız?
 

Ekli dosyalar

ayrıca88' Alıntı:
Ömer Bey,

Dosyayı ekdeki gibi tabloyla sonuç sayfasının yanına yazsam fiyatları olur mu? Çünkü her işte ayrı fiyatlandırma yapabiliyoruz. Yada 3. bir sayfa mı açmalıyız?
Genişletmek için tıkla ...

İzin de olduğumdan dolayı geri dönüş yapmam geç oldu. Kodları aşağıdaki gibi değiştirin.

Kod: 
Sub Ozet()
 
    Dim s, a1, a2, deg, dizi, c As Range
    Dim i As Long, d As Object, j As Byte
 
    Application.ScreenUpdating = False
    Sheets("Sonuç").Select
    Range("A3:E" & Rows.Count).Clear
 
    Set d = CreateObject("Scripting.Dictionary")
 
    With Sheets("Kesim Listesi")
        For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(i, "A") <> "" And .Cells(i, "F") <> "" _
                And IsNumeric(.Cells(i, "F")) = True Then
                deg = .Cells(i, "A") & "|" & .Cells(i, "B")
                If Not d.exists(deg) Then
                    s = .Cells(i, "H")
                    d.Add deg, s
                Else
                    s = d.Item(deg)
                    s = s + .Cells(i, "H")
                    d.Item(deg) = s
                End If
            End If
        Next i
    End With
 
    a1 = d.keys: a2 = d.items
 
    For i = 0 To d.Count - 1
        dizi = Split(a1(i), "|")
        For j = 0 To UBound(dizi)
            Cells(i + 3, j + 1) = dizi(j)
            Set c = Range("J:J").Find(dizi(0), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Cells(i + 3, "D") = Cells(c.Row, "L")
            End If
        Next j
        s = a2(i)
        Cells(i + 3, "C") = s
        Cells(i + 3, "E") = "=C" & i + 3 & "*D" & i + 3
    Next i
    Cells(i + 3, "E") = "=Sum(E3:E" & i + 2 & ")"
 
End Sub


.
 
Ömer Bey ilaç gibisiniz valla çok teşekkürler:)

Yalnız ürün fiyat listesinde açıklaması aynı olan ürünlerin fiyatı sonuç tablosuna geçiyor ama birimini dikkate almıyor. Aynı isimli ürün m2 veya mt birimi ile farklı fiyatlandırılabiliyor zaman zaman. Orayı detaylandırmamız mümkün mü?
Birde toplam miktar ve tutarı virgülle ayırıp, virgülden sonraki basamak sayısını 2 yapabilirsek mükemmel olacak.
Tekrardan teşekkürler.
Emeğinize sağlık
 
İstediklerinizi dosya üzerinde hatalarıyla birlikte göstererek detaylı açıklarmısınız.
 
Ekde demek istediklerimi tablo üzerinde de anlattım.
Yardımlarınız için teşekkürler..
 

Ekli dosyalar

ayrıca88' Alıntı:
Ekde demek istediklerimi tablo üzerinde de anlattım.
Yardımlarınız için teşekkürler..
Genişletmek için tıkla ...

Aşağıdaki gibi deneyin.

Kod: 
Sub Ozet()
 
    Dim s, a1, a2, deg, dizi, c As Range, ilkadres As Variant
    Dim i As Long, d As Object, j As Byte
 
    Application.ScreenUpdating = False

    Sheets("Sonuç").Select
    Range("A3:E" & Rows.Count).Clear
 
    Set d = CreateObject("Scripting.Dictionary")
 
    With Sheets("Kesim Listesi")
        For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(i, "A") <> "" And .Cells(i, "F") <> "" _
                And IsNumeric(.Cells(i, "F")) = True Then
                deg = .Cells(i, "A") & "|" & .Cells(i, "B")
                If Not d.exists(deg) Then
                    s = .Cells(i, "H")
                    d.Add deg, s
                Else
                    s = d.Item(deg)
                    s = s + .Cells(i, "H")
                    d.Item(deg) = s
                End If
            End If
        Next i
    End With
 
    a1 = d.keys: a2 = d.items
 
    For i = 0 To d.Count - 1
        dizi = Split(a1(i), "|")
        For j = 0 To UBound(dizi)
            Cells(i + 3, j + 1) = dizi(j)
            Set c = Range("J:J").Find(dizi(0), , xlValues, xlWhole)
            If Not c Is Nothing Then
                ilkadres = c.Address
                Do
                    If Cells(c.Row, "K") = Cells(i + 3, "B") Then
                        Cells(i + 3, "D") = Cells(c.Row, "L")
                    End If
                    Set c = Range("J:J").FindNext(c)
                Loop While Not c Is Nothing And c.Address <> ilkadres
            End If
        Next j
        s = a2(i)
        Cells(i + 3, "C") = s
        Cells(i + 3, "E") = "=C" & i + 3 & "*D" & i + 3
    Next i
    Cells(i + 3, "E") = "=Sum(E3:E" & i + 2 & ")"
 
End Sub
.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst