• DİKKAT

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

Makro İle Stok ve Satışları Dağıtma

Y

yalcinekmekci

Katılım
24 Nisan 2009
Mesajlar
33
Excel Vers. ve Dili
ofice 2013 Türkçe
Merhaba Arkadaşlar,
Ekteki dosyada depo depo veriye bağlı olarak hem satışları hemde stokları atabileceğimiz bir makro oluşturabilirmiyiz.Bu konuda desteklerinizi rica ediyorum.İlginiz ve desteğiniz için teşekkür ederim.
 

Ekli dosyalar

Arkadaşlar Merhaba,
Makro yapılması zor ise ekteki dosyada Veri deki bilgileri A Depo ya nasıl getirebiliriz.Teşekkürler
 

Ekli dosyalar

Merhaba
Verilerin gönderileceği ilk sayfaya:
İşaretli bölümü gereksiz ise silin veya gideceği sütunu ("r" sütununa gönderiyor) ayarlarsınız.
Kod: 
 Private Sub CommandButton1_Click()
Dim d, m As Integer
Dim s, a As Long
Dim sayfa, c As String
Dim syf As Object
Set syf = CreateObject("scripting.dictionary")
For s = 1 To Sheets.Count
sayfa = Sheets(s).Name
syf.Add sayfa, ""
Next
d = 8
For a = 2 To Cells(Rows.Count, "A").End(xlUp).Row
m = 0
For b = 4 To Cells(1, Columns.Count).End(xlToLeft).Column - 5
c = Trim(Cells(1, b).Value) & "_stok"
If syf.exists(c) = True Then
If a = 2 Then Sheets(c).Range("A8:O174,R8:W174") = ""
Sheets(c).Cells(d, "a") = Cells(a, "a")
Sheets(c).Cells(d, "b") = Cells(a, "c")
'...........................................
[COLOR="Red"]Sheets(c).Cells(d, "r") = Cells(a, b)[/COLOR]
'...........................................
Sheets(c).Cells(d, "s") = Cells(a, b + 3)
Else
m = m + 1
Cells(a, b).Interior.ColorIndex = 3
End If
b = b + 4
Next
d = d + 1
Next
If m > 0 Then MsgBox m & " Tane Bulunamayan sayfa var" & vbCrLf & vbCrLf & "kırmızı sütunlar bulunamayanlar"
Set syf = Nothing
End Sub
 
PLİNT' Alıntı:
Merhaba
Verilerin gönderileceği ilk sayfaya:
İşaretli bölümü gereksiz ise silin veya gideceği sütunu ("r" sütununa gönderiyor) ayarlarsınız.
Kod: 
 Private Sub CommandButton1_Click()
Dim d, m As Integer
Dim s, a As Long
Dim sayfa, c As String
Dim syf As Object
Set syf = CreateObject("scripting.dictionary")
For s = 1 To Sheets.Count
sayfa = Sheets(s).Name
syf.Add sayfa, ""
Next
d = 8
For a = 2 To Cells(Rows.Count, "A").End(xlUp).Row
m = 0
For b = 4 To Cells(1, Columns.Count).End(xlToLeft).Column - 5
c = Trim(Cells(1, b).Value) & "_stok"
If syf.exists(c) = True Then
If a = 2 Then Sheets(c).Range("A8:O174,R8:W174") = ""
Sheets(c).Cells(d, "a") = Cells(a, "a")
Sheets(c).Cells(d, "b") = Cells(a, "c")
'...........................................
[COLOR="Red"]Sheets(c).Cells(d, "r") = Cells(a, b)[/COLOR]
'...........................................
Sheets(c).Cells(d, "s") = Cells(a, b + 3)
Else
m = m + 1
Cells(a, b).Interior.ColorIndex = 3
End If
b = b + 4
Next
d = d + 1
Next
If m > 0 Then MsgBox m & " Tane Bulunamayan sayfa var" & vbCrLf & vbCrLf & "kırmızı sütunlar bulunamayanlar"
Set syf = Nothing
End Sub
Genişletmek için tıkla ...

Merhaba,
Elinize sağlık işimi çözdü çok teşekkür ederim.Yalnız CommandButton Sayfada çıkmıyor yanlış yaptığım bir şeymi var acaba.
 
yalcinekmekci' Alıntı:
Merhaba,
Elinize sağlık işimi çözdü çok teşekkür ederim.Yalnız CommandButton Sayfada çıkmıyor yanlış yaptığım bir şeymi var acaba.
Genişletmek için tıkla ...

PLİNT' Alıntı:
Merhaba
Rica ederim, kolay gelsin.
Örnek dosya: http://s3.dosya.tc/server6/hma463/Ornek1.zip.html
Nasıl çıkmadığını anlayamadım ama incelerseniz:http://www.excel.web.tr/f157/sayfada-commandbutton-olu-turmak-ve-makro-atamak-resimli-t68065.html
Genişletmek için tıkla ...

Teşekkür ederim plint inceleyeceğim teşekkür ederim.Elinize sağlık
 
PLİNT' Alıntı:
Merhaba
Rica ederim, kolay gelsin.
Örnek dosya: http://s3.dosya.tc/server6/hma463/Ornek1.zip.html
Nasıl çıkmadığını anlayamadım ama incelerseniz:http://www.excel.web.tr/f157/sayfada-commandbutton-olu-turmak-ve-makro-atamak-resimli-t68065.html
Genişletmek için tıkla ...

Merhaba Plint ve Arkadaşlar,
Ekteki ve linkteki dosyada satışları ve stokları diğer sheet lere gönderiyoruz.Yalnız şöyle bir problemim bu verileri gönderirken diğer hücrelerin içleride siliniyor veri kalmıyor.Acaba bu verileri gönderirken diğer hücrelerin silinmemesini sağlayabilirmiyiz.İlginiz için teşekkür ederim
 
yalcinekmekci' Alıntı:
Merhaba Plint ve Arkadaşlar,
Ekteki ve linkteki dosyada satışları ve stokları diğer sheet lere gönderiyoruz.Yalnız şöyle bir problemim bu verileri gönderirken diğer hücrelerin içleride siliniyor veri kalmıyor.Acaba bu verileri gönderirken diğer hücrelerin silinmemesini sağlayabilirmiyiz.İlginiz için teşekkür ederim
Genişletmek için tıkla ...

Dosyayı eklemeyi unutmuşum.
 

Ekli dosyalar

Kod: 
If a = 2 Then Sheets(c).Range("A8:O174,R8:W174") = ""

Kod satırını aşağıdaki gibi deneyiniz.

Kod: 
If a = 2 Then Sheets(c).Range("A8:B174,R8:S174") = ""
 
Ziynettin' Alıntı:
Kod: 
If a = 2 Then Sheets(c).Range("A8:O174,R8:W174") = ""

Kod satırını aşağıdaki gibi deneyiniz.

Kod: 
If a = 2 Then Sheets(c).Range("A8:B174,R8:S174") = ""
Genişletmek için tıkla ...

Merhaba,
Malesef yine aynı alta ilave yazmıyor ama Hem ürün kodunu ve Hem ürün ismini siliyor.Ve A2 hücresinden yazıyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst