• DİKKAT

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

İthal-Yerli satış ayırma

  • Konbuyu başlatan Konbuyu başlatan HAKANP
  • Başlangıç tarihi Başlangıç tarihi
H

HAKANP

Katılım
17 Nisan 2006
Mesajlar
228
Selam arkadaşlar,
* Yurtdışına sattığımız ürünlere göre satış koşullarımız ve para birimlerimiz değişiyor
* Düğme1 basıldığında "b" sütünündaki verileri ithal sayfasından sorgulayacak şayet var ise "E" ve "F" sütunlarına satış ve para birimlerini getirecek
yok ise iç satış değerleri gelecek
* sonraki işlem ise yerli satış ve ithal satış sayfalarına satışları dağıtacak
* olması gereken sonuçları ben hazırladım

Şimdiden çok teşekkürler.
 

Ekli dosyalar

HAKANP' Alıntı:
Selam arkadaşlar,
* Yurtdışına sattığımız ürünlere göre satış koşullarımız ve para birimlerimiz değişiyor
* Düğme1 basıldığında "b" sütünündaki verileri ithal sayfasından sorgulayacak şayet var ise "E" ve "F" sütunlarına satış ve para birimlerini getirecek
yok ise iç satış değerleri gelecek
* sonraki işlem ise yerli satış ve ithal satış sayfalarına satışları dağıtacak
* olması gereken sonuçları ben hazırladım

Şimdiden çok teşekkürler.
Genişletmek için tıkla ...

Merhaba
Boş bir module kopyalayın ve deneyin
Kod: 
Option Explicit
Sub ithallatımız_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, kral, asi
Set bordo = Sheets("satış")
Set mavi = Sheets("ithal")
Set kral = Sheets("yerli satış")
Set asi = Sheets("ithal satış")
trabzonspor = MsgBox("İthalat ve Yerli Olarak Ayırıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
kral.Range("A2:C" & Rows.Count).ClearContents
asi.Range("A2:C" & Rows.Count).ClearContents
For ts = 3 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If WorksheetFunction.CountIf(mavi.Range("A:A"), bordo.Cells _
(ts, "B")) > 0 Then
kaplan = asi.Range("A" & Rows.Count).End(xlUp).Row
bordo.Cells(ts, "E") = WorksheetFunction.VLookup(bordo.Cells(ts, "B"), _
mavi.Range("A:C"), 2, 0)
bordo.Cells(ts, "F") = WorksheetFunction.VLookup(bordo.Cells(ts, "B"), _
mavi.Range("A:C"), 3, 0)
asi.Cells(kaplan + 1, "A") = bordo.Cells(ts, "B")
asi.Cells(kaplan + 1, "B") = bordo.Cells(ts, "G")
asi.Cells(kaplan + 1, "C") = bordo.Cells(ts, "H")
Else
kaplan = kral.Range("A" & Rows.Count).End(xlUp).Row
bordo.Cells(ts, "E") = bordo.Cells(ts, "C")
bordo.Cells(ts, "F") = bordo.Cells(ts, "D")
kral.Cells(kaplan + 1, "A") = bordo.Cells(ts, "B")
kral.Cells(kaplan + 1, "B") = bordo.Cells(ts, "G")
kral.Cells(kaplan + 1, "C") = bordo.Cells(ts, "H")
End If
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Ayrım Tamamlandı", , "Bitiş"
End Sub
 
İlginize ve emeğinize çok teşekkür ederim.
Kendi dosyama göre uyarlayacağım.
 
Peki ithal ürünlerin "satış" ve "birim" değerlerini ithal sayfasından getirmek için ne yapmalıyız
dosya ektedir.
 

Ekli dosyalar

Son düzenleme:
HAKANP' Alıntı:
Peki ithal ürünlerin "satış" ve "birim" değerlerini ithal sayfasından getirmek için ne yapmalıyız
dosya ektedir.
Genişletmek için tıkla ...

Taksit taksit söylüyorsunuz tamamını bir seferde sorsanız olmaz mı_?
Dosya eklemişsiniz ama daha eklediğim makroyu içine bile eklememişsiniz_?
 
İhsan Tank' Alıntı:
Taksit taksit söylüyorsunuz tamamını bir seferde sorsanız olmaz mı_?
Dosya eklemişsiniz ama daha eklediğim makroyu içine bile eklememişsiniz_?
Genişletmek için tıkla ...

Ben forumdaki tüm dosyaları örnek amaçlı soruyorum. Verdiğiniz tüm kodları kendi dosyama uyarlayarak değiştirdim çalıştığını beyan ederekte teşekkür ettim. İspat için kendi dosyamı size gönderebilirim. Amacı olmayan hiç bir soruyu yönlendirmiyorum.

Ayrıca taksit taksit söylemiyorum. Kodlarınızı çalıştırdıktan ve kendi dosyama uyguladıktan sonra ihtiyaç olan bir soru sordum.

Yanıtınız için teşekkür ederim.
 
Kod: 
Option Explicit
Sub ithallatımız_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim banka, hesap, odenecek, izahat, garanti, tekfen
Set banka = Sheets("BANKA")
Set hesap = Sheets("HESAP")
Set garanti = Sheets("GARANTİ")
Set tekfen = Sheets("TEKFEN")
odenecek = 0
Application.ScreenUpdating = False
hamsi = Time
izahat = Worksheets("GIRIS").Range("C3") & " " & Worksheets("GIRIS").Range("C2") & ". Ay " & Worksheets("GIRIS").Range("C4") & " Ödemesi"
garanti.Range("A13:I" & Rows.Count).ClearContents
tekfen.Range("A11:J" & Rows.Count).ClearContents


For ts = 2 To banka.Cells(Rows.Count, "B").End(xlUp).Row
If WorksheetFunction.CountIf(hesap.Range("A:A"), banka.Cells _
(ts, "B")) > 0 Then
kaplan = tekfen.Range("A" & Rows.Count).End(xlUp).Row
tekfen.Cells(kaplan + 1, "A") = banka.Cells(ts, "D") & " " & banka.Cells(ts, "E")
tekfen.Cells(kaplan + 1, "C") = "9076"
tekfen.Cells(kaplan + 1, "F") = banka.Cells(ts, "H")


Else
kaplan = garanti.Range("A" & Rows.Count).End(xlUp).Row
odenecek = odenecek + banka.Cells(ts, "H")
garanti.Cells(kaplan + 1, "A") = banka.Cells(ts, "D") & " " & banka.Cells(ts, "E")
garanti.Cells(kaplan + 1, "B") = banka.Cells(ts, "C")
garanti.Cells(kaplan + 1, "C") = "62"
garanti.Cells(kaplan + 1, "D") = banka.Cells(ts, "F")
garanti.Cells(kaplan + 1, "E") = banka.Cells(ts, "G")
garanti.Cells(kaplan + 1, "G") = banka.Cells(ts, "H")
garanti.Cells(kaplan + 1, "H") = izahat
garanti.Cells(kaplan + 1, "I") = izahat
End If
Next
garanti.Cells(9, "b").Value = izahat
garanti.Cells(4, "b").Value = kaplan - 11
garanti.Cells(5, "b").Value = odenecek
garanti.Cells(7, "b").Value = Day(Date) & Month(Date) & Year(Date)
Application.ScreenUpdating = True

End Sub

Kodlarınızın bende uygulanmış hali böyledir.
 
HAKANP' Alıntı:
Ben forumdaki tüm dosyaları örnek amaçlı soruyorum. Verdiğiniz tüm kodları kendi dosyama uyarlayarak değiştirdim çalıştığını beyan ederekte teşekkür ettim. İspat için kendi dosyamı size gönderebilirim. Amacı olmayan hiç bir soruyu yönlendirmiyorum.

Ayrıca taksit taksit söylemiyorum. Kodlarınızı çalıştırdıktan ve kendi dosyama uyguladıktan sonra ihtiyaç olan bir soru sordum.

Yanıtınız için teşekkür ederim.
Genişletmek için tıkla ...

Bunu ilk sorunuzda sormuş olsaydınız ona göre düzenleme yapardık Makro ile yaptığımız için belli kısımları ona göre yapıyoruz şimdi sıfırdan bir daha makro yazmak gerekiyorsa ne olacak.
Ayrıca yeni eklediğiniz dosyanızda İthal sayfasında fiyat yok güncelleyin bende kodu düzenleyip göndereyim.
 
İhsan Tank' Alıntı:
Bunu ilk sorunuzda sormuş olsaydınız ona göre düzenleme yapardık Makro ile yaptığımız için belli kısımları ona göre yapıyoruz şimdi sıfırdan bir daha makro yazmak gerekiyorsa ne olacak.
Ayrıca yeni eklediğiniz dosyanızda İthal sayfasında fiyat yok güncelleyin bende kodu düzenleyip göndereyim.
Genişletmek için tıkla ...

#4 mesajı güncelledim
 
HAKANP' Alıntı:
#4 mesajı güncelledim
Genişletmek için tıkla ...

Merhaba
Kodu bununla değiştirin
Kod: 
Option Explicit
Sub ithallatımız_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, kral, asi
Set bordo = Sheets("satış")
Set mavi = Sheets("ithal")
Set kral = Sheets("yerli satış")
Set asi = Sheets("ithal satış")
trabzonspor = MsgBox("İthalat ve Yerli Olarak Ayırıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
kral.Range("A2:C" & Rows.Count).ClearContents
asi.Range("A2:C" & Rows.Count).ClearContents
For ts = 3 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If WorksheetFunction.CountIf(mavi.Range("A:A"), bordo.Cells _
(ts, "B")) > 0 Then
kaplan = asi.Range("A" & Rows.Count).End(xlUp).Row
bordo.Cells(ts, "C") = WorksheetFunction.VLookup(bordo.Cells(ts, "B"), _
mavi.Range("A:E"), 4, 0)
bordo.Cells(ts, "D") = WorksheetFunction.VLookup(bordo.Cells(ts, "B"), _
mavi.Range("A:E"), 5, 0)
bordo.Cells(ts, "E") = WorksheetFunction.VLookup(bordo.Cells(ts, "B"), _
mavi.Range("A:E"), 2, 0)
bordo.Cells(ts, "F") = WorksheetFunction.VLookup(bordo.Cells(ts, "B"), _
mavi.Range("A:E"), 3, 0)
asi.Cells(kaplan + 1, "A") = bordo.Cells(ts, "B")
asi.Cells(kaplan + 1, "B") = bordo.Cells(ts, "E")
asi.Cells(kaplan + 1, "C") = bordo.Cells(ts, "F")
asi.Cells(kaplan + 1, "D") = bordo.Cells(ts, "C")
asi.Cells(kaplan + 1, "E") = bordo.Cells(ts, "D")
Else
kaplan = kral.Range("A" & Rows.Count).End(xlUp).Row
kral.Cells(kaplan + 1, "A") = bordo.Cells(ts, "B")
kral.Cells(kaplan + 1, "B") = bordo.Cells(ts, "E")
kral.Cells(kaplan + 1, "C") = bordo.Cells(ts, "F")
kral.Cells(kaplan + 1, "D") = bordo.Cells(ts, "C")
kral.Cells(kaplan + 1, "E") = bordo.Cells(ts, "D")
End If
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Ayrım Tamamlandı", , "Bitiş"
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst