tüm maclardan takıma ayrı fikstür yazdırmak

[stormrider121]

Ligdeki tüm maclardan, istediğim takımın fikstürünü nasıl cıkarabilirim? Yardımcı olursanız çok sevinirim.

 

[danersin]

Bir modüle aşağıdaki kodları yazarak çalıştırın. Makrolu çözüm daha basit olduğı için böyle çözdüm, çözdükten sonra fonksiyon bölümüne sorunuzu sorduğunuzu farkettim. İlla fonksiyonlar ile çözüm gerekiyorsa o şekilde düşünelim.(mi)?

[vb:1:75ca9a93b8]Sub cekal()
Application.ScreenUpdating = False
takimim = Cells(1, 10)
k = 2
For i = 1 To Cells(1, 1).End(xlDown).Row
If Cells(i, 1) = takimim Or Cells(i, 2) = takimim Then
Range(Cells(i, 1), Cells(i, 4)).Copy
Range(Cells(k, 7), Cells(k, 10)).PasteSpecial
k = k + 1
End If
Next i
Application.CutCopyMode = False
End Sub[/vb:1:75ca9a93b8]

 

[stormrider121]

çhok sağolun cvp icin ama ben daha yeni excel kullanıcısıyım.İlla fonksiyonları kullanarak bi cözüm gerekmiyo ama makro kullanımı hakkında pek bishey bildiğim söylenemez.Nette makro kullanımın anlatan bi kac site var onlara baktım ama pek bişey anlamadım doğrusu.Siz örnek bi dosya gönderebilirmisiniz yukarıdaki makroyu iceren?

 

[danersin]

Dosya ektedir. Birde linkteki program ilginizi çekebilir.

http://www.excel.web.tr/viewtopic.php?t=2273

 

[stormrider121]

makro icin çok saolun.tüm macları yazıyo ama bu seferde son 6 macını yazdırmak istesem makroya ne eklemem gerekiyo.programa baktım yukarıda istediğim şeyi siz de ekleseniz Takımın son haftalardaki performansını görmek isteyenler icin cok faydalı olur diye düsünüyorum.

 

[stormrider121]

birde diğer bir sorum aynı sayfada 18 takımında ayrı fikstürlerini görmek istesem 18 makromu yazmak gerekiyo.Ben yapmaya calıstım ama birbirleriyle bağımlı oldular.

 

[danersin]

[vb:1:27eac4f817]Sub cekal()
Application.ScreenUpdating = False
takimim = Cells(1, 10)
k = 2
For i = Cells(1, 1).End(xlDown).Row To 1 step -1
If Cells(i, 1) = takimim Or Cells(i, 2) = takimim Then
Range(Cells(i, 1), Cells(i, 4)).Copy
Range(Cells(k, 7), Cells(k, 10)).PasteSpecial
k = k + 1
if k>6 then exit sub
End If
Next i
Application.CutCopyMode = False
End Sub [/vb:1:27eac4f817]


Son altı maç için yukarıdaki kodun işgörmesi lazım..

Farklı takımın fikstürünü basmak için listenin hemen yanında L1 hücresiydi sanırım takımın ismini değiştirdiğinizde makro o hücredeki takımın fikstürünü döker.

 

[stormrider121]

18ninde aynı anda sayfada gözükmesi icin sormustum ama sonra hallettim.18 tane makro yazıp hepsinide farklı yerlere yazdırdım isimi gördü şimdilik.son 6 maç olayınıda hallettim önce son 5 macı verdi k>7 yaparak hallettim.sayende makroda öğreniyorum yavas yavas.Çok sağol.

 

[danersin]

böyle böyle öğrenilir zaten
18 defa yazmanıza gerek yoktu kodu ama neyse. Kolay gelsin.

 

[stormrider121]

sadece türkiye liginde islerimi hallederken 18 defa yapmak zor gelmedi ama simdi düsününce baska liglerdede yapınca bir sürü takım olcak.Aynı makrodan 100lerce olucak yani.Yukarıda gerek yok demissiniz de ne yapmam gerekiyo onun icin?

 

[danersin]

@stormrider

Bunu sayfada ne şekilde istediğinizi bilmezsem biraz boşa uğraşmış olurum. Yani alt alta, yan yana, , şekli şemali nasıl olacak. İsterseniz dosyanızı ekleyin (veya sadece o sayfanın aynısı bir kopya yapın) ve ne şekilde istediğinizi açıklayın öyle bakalım.

 

[stormrider121]

aralarında 40 satır olmak üzere alt alta yaptım ben.örnekte sadece 3 takımın fikstürü var(G.Antepspor,Galatasaray,Rizespor).

 

[danersin]

Sn. stormrider tam deneme fırsatım olmadı ama bir bakın bakalım olmuşmu.

 

[stormrider121]

Çok çok saolun calışıyo, galiba cok fazla sey istedim ama bu seferde tüm takımların son 6 macını yazdırabilecek komutu söyleyebilirmisiniz?(If k>6 Then Exit Sub) yazdıımda k=k+1 den sonra sadece bir takımınkini yazıp sona eriyo (exitsub) nedeniyle.

 

[danersin]

Sorularınızlada, cevaplarınızlada foruma katılmanız bizim ancak hoşumuza gider. Asla sıkmaz.

Sorunuza en basit ve anlaması kolay çözümü kaç takım yazıldığını takip etmek içinde bir değişken kullanalım "z" olsun z ile ilgili rakamları değiştirerek istediğiniz kadar takımı yazdırabilirsiniz. Yani şöyle birşey oldu.


[vb:1:ef43cd6b43]Sub cekal()
Application.ScreenUpdating = False
k = 2
t = 2 'takım listesini yazmaya başladığınız satır sayısı, sütunda 12
z = 1
Do While Cells(t, 12) <> ""
takimim = Cells(t, 12)
Cells(k - 1, 10) = takimim
For i = 1 To Cells(1, 1).End(xlDown).Row
If Cells(i, 1) = takimim Or Cells(i, 2) = takimim Then
Range(Cells(i, 1), Cells(i, 4)).Copy
Range(Cells(k, 7), Cells(k, 10)).PasteSpecial
k = k + 1
z = z + 1
If z > 7 Then GoTo 50
End If
Next i
50
z = 1
k = k + 20 'takım fisktürleri arasında kaç boşluk isterseniz 20'yi ona göre ayarlayın
t = t + 1
Loop

Application.CutCopyMode = False
End Sub[/vb:1:ef43cd6b43]

 

[stormrider121]

Gerçekten cok basit ve esnek oldu yazdığınız makro.Pazar günü evde oturduğum için kendimi şanslı hissettim sayenizde.Çok sağolun.

 

[danersin]

:keyif: Ne mutlu bize. Her pazar bekleriz. :hey:

 

[stormrider121]

O gün dikkatimi çekmemişti am bugün baktığımda ilk 6 maclarını yazdırdığını farkettim son 6 maç yerine.Denedim değistirmeyi ama olmadı.Tekrar yardımcı olabilrmisiniz?

 

[danersin]

[vb:1:68d6a64e5a]For i = 1 To Cells(1, 1).End(xlDown).Row[/vb:1:68d6a64e5a]
yerine
[vb:1:68d6a64e5a]For i =Cells(1, 1).End(xlDown).Row to 1 step -1[/vb:1:68d6a64e5a]

yazmayı denermisiniz. (Artık bunuda öğrendiniz sanırım. ilkinde i=1 den sonsatıra kadar bu işi yap diyorduk, ikincide son satırdan ilk satıra kadar bunu yap diyoruz.)

 

[stormrider121]

Denedim oldu cok tesekküer ederim tekrar.Bu sayede onu da öğrendim.Her gün kendime yeni şeyler katıyorum.Saolun.