• DİKKAT

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

Sayfa 1 ve sayfa 2 de tarihe göre arama karşılık gelen sütünları sayfa2 göstermek

M

mustilem23

Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
İyi geceler ,
uykumu kaçıran şirkette çözüm yolu bulamadığım bir sorunum var yardımcı olabilmeniz mümkünmüdür ?

ekli dosyada anlatım yaptım kısaca deyinmek gerekirse ,sayfa 1 de bulunan no sutunundaki sayıları 1 e düşürüp ,en üst tarihe göre diğer sütunları kopyalamk istiyorum ardından çarpan ile tl fiyatı olarak listelemek için yardımcı olabilir misiniz ,

özet tablo ile denedim fakat çok başarılı olamadım makro ile yapılabilmesi mümkünmüdür,



http://s5.dosya.tc/server3/arvwja/calisma.xlsx.html
 
Arkadaşlar yardımcı olabilir misiniz rica etsem .
 
3507005011 zımba govde 370,25 TL 27.10.201 629,425
3507005012 zımba govde 245 USD 27.10.2016 708,05
674546561123 zımba govde 145 EUR 26.10.2016 843,03

Tablonuza göre kırmızı rakamlar doğru mu. Bu sonuçlara ulaşamadım.

Yaptığım sonuç;
3507005011 zımba govde 370,25 TL 27.10.2016 629,425
3507005012 zımba govde 245 USD 27.10.2016 761,95
674546561123 zımba govde 145 EUR 26.10.2016 495,9
 
ben onları el ile yapmıştım farklılık olmuş olabilir ,eur yada usd çarpanı baz alabiliyor isek sorun olmayacağını düşünüyorum ,ilginiz için teşekkür ederim.
nasıl yapabildiniz makro ile mi ?
 
Makro ile

Kod: 
Option Explicit
Sub Aktar()
Dim a(), b(), d As Object
Dim i As Long, Say As Long
Dim Krt, Dolar As Double, Euro As Double, TLçarpan As Double
Set d = CreateObject("Scripting.Dictionary")
a = Range("A2:E" & Cells(Rows.Count, 1).End(3).Row)
Dolar = [K1]
Euro = [K3]
TLçarpan = [K4]
ReDim b(1 To UBound(a), 1 To 6)
For i = 1 To UBound(a)
    'Krt = a(i, 1) & "|" & a(i, 4)
    [COLOR="Red"]Krt = a(i, 1)[/COLOR]
    If Not d.exists(Krt) Then
        Say = Say + 1
        d.Add Krt, Say
        b(Say, 1) = a(i, 1)
        b(Say, 2) = a(i, 2)
        b(Say, 3) = a(i, 3)
        b(Say, 4) = a(i, 4)
        b(Say, 5) = a(i, 5)
        If a(i, 4) = "USD" Then
            b(Say, 6) = a(i, 3) * Dolar
        End If
        If a(i, 4) = "EUR" Then
            b(Say, 6) = a(i, 3) * Euro
        End If
        If a(i, 4) = "TL" Then
            b(Say, 6) = a(i, 3) * TLçarpan
        End If
    End If
Next i
With Sheets("LISTE")
If Say > 0 Then
    .Range("A2:F" & Rows.Count).ClearContents
    .Range("A2").Resize(Say, 6) = b
End If
End With
MsgBox "İşlem tamam.", vbInformation
End Sub
 

Ekli dosyalar

Son düzenleme:
Krt = a(i, 1) & "|" & a(i, 4) satırnı Krt =a(i,1) olarak düzenlendi.

Kodu tekrar deneyin
 
Elinize sağlık fakat en küçük tarihi baz alıyor ,bize en son satın alma tarihi lazımdı ,(bugüne en yakın tarihi baz almamız lazım) yardımcı olabilmeniz mümkün müdür ?
 
Ziynettin Bey ,

stok koduna ve tarihe göre koşullu sıralatıp makroyu çalıştırınca oldu emeğiniz için çok teşekkürler,
bir sıkıntım var aynı konuda ilk sayfaya 1 2 sutun daha eklesem onlarıda aktarsa kod içinde nasıl bir güncelle yapabiliriz .indirim oranı ,tedarikçi gibi 2 sutun daha ekleyip ana veriye öyle almam gerikiyor.yarımcı olabilmeniz mümkün müdür,teşekkürler...
 
mustilem23' Alıntı:
Elinize sağlık fakat en küçük tarihi baz alıyor ,bize en son satın alma tarihi lazımdı ,(bugüne en yakın tarihi baz almamız lazım) yardımcı olabilmeniz mümkün müdür ?
Genişletmek için tıkla ...

Liste sayfanıza 3303620355 stok kodu birimi EUR yazdırılıyor.


3303620355 stok koduna ait EUR ve TL birim mevcut, en son tarihi aktarmak için sadece stok koduna göre mi? ya da birim ve stok koduna göre mi? yazdırılacak.
 
Yeni sutun eklenmiş ve ve son tarihe göre hesaplanmış şekli linkteki gibidir.
http://s5.dosya.tc/server3/8dg1og/ornek_liste.rar.html

3303620355 nolu stokkodu enson hangi tarihte alındı ise o satırları yazdırmamız lazım alış tipi tl yada usd,eur önemli değil çünki satın alma şartnameleri en son sipariş tarihine göre hesaplayıp fiyat listesi oluşturmak lazım,
 
Buyrun..

Kod: 
Option Explicit

Sub Güncel_Tarih()
Dim a(), b(), d1 As Object
Dim Say As Long, X As Long, c As Variant
Dim Kriter, Dolar As Double, Euro As Double, TLçarpan As Double
Application.ScreenUpdating = False
Sheets("SAS").Select
Set d1 = CreateObject("Scripting.Dictionary")
a = Range("A2:G" & Cells(Rows.Count, 1).End(3).Row)
Dolar = [K1]
Euro = [K7]
TLçarpan = [K6]
ReDim b(1 To UBound(a), 1 To 8)
    For X = 1 To UBound(a)
        Kriter = a(X, 1)
        If d1.exists(Kriter) Then
            If a(X, 5) > a(d1(Kriter), 5) Then
                d1(Kriter) = X
            End If
        Else
            d1(Kriter) = X
        End If
    Next X
    For Each c In d1.keys
        Say = Say + 1
        b(Say, 1) = a(d1(c), 1)
        b(Say, 2) = a(d1(c), 2)
        b(Say, 3) = a(d1(c), 3)
        b(Say, 4) = a(d1(c), 4)
        b(Say, 5) = a(d1(c), 5)
    If a(d1(c), 4) = "USD" Then
        b(Say, 6) = b(Say, 3) * Dolar
    End If
    If a(d1(c), 4) = "EUR" Then
        b(Say, 6) = b(Say, 3) * Euro
    End If
    If a(d1(c), 4) = "TL" Then
        b(Say, 6) = b(Say, 3) * TLçarpan
    End If
        b(Say, 7) = a(d1(c), 6)
        b(Say, 8) = a(d1(c), 7)
    Next c
With Sheets("LISTE")
If Say > 0 Then
    .Range("A2:H" & Rows.Count).ClearContents
    .Range("A2").Resize(Say, 8) = b
    .Range("E2").Resize(Say).NumberFormat = "dd.mm.yyyy"
    .Range("F2").Resize(Say).NumberFormat = "#,##0.00"
End If
.Select
End With
Application.ScreenUpdating = True
MsgBox "İşlem tamam.", vbInformation
End Sub

http://s4.dosya.tc/server3/n0v71j/ornek_liste.rar.html
 

Ekli dosyalar

Ellerinize sağlık çok teşekkür ederim bursa ya yolunuz düşerse bir kahve içmeye beklerim .
zamanınız var ise bir sorunum daha var bu konuya başka bbir emailden veri aktarmam (yani diğer müşterilere satılmış fiyatlarda göstermek) zamanınız var ise bu konuya değinelimmi.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst