Şarta bağlı olarak aynı olanları toplamak

[Eser Gökay]

Arkadaslar bir hucredeki sartin olmasi durumunda baska hucredeki verilerin toplanarak baska sayfaya atilmasi konusunda macroya ihtiyacim var. daha ayrintili bilgi dosyada. tesekkur ediyorum...

 

[Eser Gökay]

sayın forum uyeleri bu konuda fikri olanların yardımlarını rica ediyorum

 

[AS3434]

Kendi çapımda birşeyler yaptım ama, 4000 satırda nasıl çalışır bilmem.

 

[Eser Gökay]

Sayın AS3434


maalesef macro hic calismiyor. diger sayfalardan sadece mal cinslerinin isimleri yan tarafa yaziyor ve macro hata veriyor. Birlestirilen hucrelerin boyutlariyla ilgili olarak

 

[AS3434]

Gönderdiğim dosya bende çalışıyor, tekrar indirdim denedim sorun yok gibi.

Kendi dosyanıza uygulamada mı sorun var? Yoksa benim gönderdiğimde mi?

Kodların neresinde hata veriyor?

Sub Makro1()
Application.ScreenUpdating = False
Set s1 = Sheets("Gid")
Set s2 = Sheets("Gel")
Set s3 = Sheets("Stok")
Set wf = WorksheetFunction
[a3:h4000].ClearContents
s1.[K3:K4000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=s3.[m2], Unique:=True
son = [m65536].End(3).Row + 1
s2.[o5:o4000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=s3.Range("m" & son), Unique:=True
[m2:m4000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[o2], Unique:=True
son1 = [o65536].End(3).Row
Range("o3:o" & son1).Copy
Range("A3,D3,g3").PasteSpecial Paste:=xlPasteValues
For p = 3 To son1
z = Cells(p, 1).Address
Cells(p, 2) = Evaluate("=SumProduct((gici =" & z & ") * (gist = ""Var"") * (gimi))")
Cells(p, 5) = Evaluate("=SumProduct((geci =" & z & ") * (gest = ""Var"") * (gemi))")
Cells(p, 8) = Cells(p, 2) - Cells(p, 5)
Next
Range("M:M,O:O").Delete Shift:=xlToLeft
[j2].Select
End Sub

gici,gist.....Alan adlarıdır. Kendi dosyanızda da uygulayın.

 

[Eser Gökay]

sizin dosyanızı indirip denedim. calismiyor. macro hucre boyutlariyla ilgili hata veriyor. sonlandırdigim zamanda verileri alacagi sayfalardan sadece mal isimlerini alıyor ve oyle bırakıyor. (miktar ve tutar kısımları yok) giren ve çıkan diye adlandirdigim hucrelere herhangi deger atmıyor.

 

[Eser Gökay]

Range("A3,D3,g3").PasteSpecial Paste:=xlPasteValues kısmında hata veriyor.

 

[AS3434]

İlginç.
Yukardaki dosyayı indiriyorum, herhangi bir sorun yok, çalışıyor.
Bir ayar sorunu var ama , anlamadım.

Makroyu çalıştırdım, çalışmış hali ile dosyayı yeniden yüklüyorum.(Herhangi bir değişiklik yapmadım.)

 

[Recep İpek]

Bende de gayet güzel çalışıyor....

 

[Eser Gökay]

3 sayfadaki resimlere bakar miniz

Sayın ustalarım durumu resimlerle anlatmaya calistim. yapilabilecek bir sey varsa yardimlarinizi rica eder, yoksa da vaktinizi caldigim icin ozur dilerim.

 

[AS3434]

Sayın Muhasebecieser

Anlayamıyorum. Orada birleştirilmiş hücre yok ki!!

Vakit almakla ilgisi yok, sorununuzu çözmek bizim için şu anda daha önemli.
Kodların o bölümünü şöyle değiştirin. Bakalım ne olacak.

.
.
 
Range("o3:o" & son1).Copy 'mevcut kod
[a3].PasteSpecial Paste:=xlPasteValues 'yeni
[d3].PasteSpecial Paste:=xlPasteValues 'Yeni
[g3].PasteSpecial Paste:=xlPasteValues 'yeni
[COLOR=green]'Range("A3,D3,g3").PasteSpecial Paste:=xlPasteValues[/COLOR]
For p = 3 To son1 'mevcut
.
.

 

[Eser Gökay]

Son defa rahatsız edeyim.

Sayın AS3434

macronun 1. kismi tamamdir. ellerinize saglik. cok tesekkur ediyorum.

Su ana kadar macroyu calistirip gonderdiginiz calismalari goremedigim icin kalan son eksikligi de ekten bakmanizi rica ediyorum. iyi calismalar diliyorum.

 

[AS3434]

Dosyanız ekte.

 

[Eser Gökay]

Sn AS3434 cok tesekkur ediyorum. ellerinize saglik.

 

[Eser Gökay]

Sn AS3434 sanırım beceriksizin tekiyim, sizden aldıgım kodları (fazla yer kaplamasın diye dosyamın kucuk halini eklemistim.) kendi dosyama uygulamaya calisinca sacma sapan sonuclar cikti ortaya. satirlar ve sutunlar degismedigi halde. ilgilenirseniz cok mutlu olurum. simdiden tesekkurler...


Dosya gerçek veriler içerdiği için tarafımdan silinmiştir. AS3434

 

[AS3434]

gici,gist.....Alan adlarıdır. Kendi dosyanızda da uygulayın.

Sorunlu dediğiniz dosyada Alan Adı tanımlarınızı yapmamışsınız.

Cells(p, 2) = Evaluate("=SumProduct(([COLOR=red]gici[/COLOR] =" & z & ") * ([COLOR=red]gist [/COLOR]= ""Var"") * ([COLOR=red]gimi[/COLOR]))")
Cells(p, 5) = Evaluate("=SumProduct(([COLOR=red]geci [/COLOR]=" & z & ") * ([COLOR=red]gest [/COLOR]= ""Var"") * ([COLOR=red]gemi[/COLOR]))")
Cells(p, 3) = Evaluate("=SumProduct((gici =" & z & ") * (gist = ""Var"") * ([COLOR=red]gitu[/COLOR]))")
Cells(p, 6) = Evaluate("=SumProduct((geci =" & z & ") * (gest = ""Var"") * ([COLOR=red]getu[/COLOR]))")

Kırmızı yerler, Alan tanımlarıdır.

 

[Eser Gökay]

ustam bu seferde

Cells(p, 8) = Cells(p, 2) - Cells(p, 5) kısmında hata veriyor.

 

[Eser Gökay]

ustalar cok fazla oldugumun farkındayim, ama şu işe bir el atan olursa cok makbule gececek inanın...

 

[AS3434]

Sayın muhasebecieser

Dosyanız ekte.

Hata vermesinin nedeni, Topla.çarpım formülü nümerik (sayısal) olmayan hücrelerde hataya neden oluyor. Siz de miktar ve tutar satırlarına sayısal olmayan değerler girmişsiniz. (1 Adet, İptal ..... gibi)

Tutarları KDV dahil sütundan hesapladım.....

Sonradan farkettim.. Dosya gerçek veriler içerdiği için tarafımdan kaldırılmıştır.

 

[Eser Gökay]

mesajınızı geç gördüm. hassasiyetiniz için tesekkur ederim. gercek dosyayi en son macroları calistirmayi beceremeyince eklemek durumunda kaldim. siz den gelecek cevaba gore silmeyi dusunuyordum. benden once davrandiniz. tekrar tesekkur ediyorum.