Diğer Sayfalardan Seçime Göre Veri Al, Sırala, Diğer Sayfalardan

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,715
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Merhaba,

4 ligin takımları ve maç skorları olan sayfadan "Süz" sayfasına seçilen takıma göre fikstürü almak istiyorum,

Örnek dosya ve açıklamalar ek'tedir,

Teşekkür ederim,

NOT ; Makro ile de olabilir.
 

Ekli dosyalar

İ

İhsan Tank

Misafir
Merhaba,

4 ligin takımları ve maç skorları olan sayfadan "Süz" sayfasına seçilen takıma göre fikstürü almak istiyorum,

Örnek dosya ve açıklamalar ek'tedir,

Teşekkür ederim,

NOT ; Makro ile de olabilir.
merhaba
boş bir module kopyalayın ve deneyin.
Kod:
Option Explicit
Sub aktar()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox(Sheets("Süz").Range("J1") & " Takımının" _
& " Maçlarını Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
Sheets("Süz").Range("F18:M51").ClearContents
kaplan = 18
For ts = 2 To Sheets("GENEL").Cells(65536, "B").End(xlUp).Row
If Sheets("GENEL").Cells(ts, "C") = WorksheetFunction.Proper(Sheets("Süz").Range("J1")) _
Or Sheets("GENEL").Cells(ts, "F") = WorksheetFunction.Proper(Sheets("Süz").Range("J1")) Then
Sheets("Süz").Cells(kaplan, "G") = Sheets("GENEL").Cells(ts, "B") 'tarih
Sheets("Süz").Cells(kaplan, "H") = Sheets("GENEL").Cells(ts, "C") '1.takım
Sheets("Süz").Cells(kaplan, "I") = Sheets("GENEL").Cells(ts, "D") '1'skor
Sheets("Süz").Cells(kaplan, "J") = Sheets("GENEL").Cells(ts, "F") '2.takım
Sheets("Süz").Cells(kaplan, "K") = Sheets("GENEL").Cells(ts, "E") '2.skor
If Sheets("Süz").Cells(kaplan, "I") = "" And Sheets("Süz").Cells(kaplan, "K") = "" Then
Sheets("Süz").Cells(kaplan, "L") = ""
ElseIf Sheets("Süz").Cells(kaplan, "I") = Sheets("Süz").Cells(kaplan, "K") Then
Sheets("Süz").Cells(kaplan, "L") = "B"
ElseIf Sheets("Süz").Cells(kaplan, "H") = WorksheetFunction.Proper(Sheets("Süz").Range("J1")) Then
If Sheets("Süz").Cells(kaplan, "I") > Sheets("Süz").Cells(kaplan, "K") Then
Sheets("Süz").Cells(kaplan, "L") = "G"
Else
Sheets("Süz").Cells(kaplan, "L") = "M"
End If
ElseIf Sheets("Süz").Cells(kaplan, "J") = WorksheetFunction.Proper(Sheets("Süz").Range("J1")) Then
If Sheets("Süz").Cells(kaplan, "K") > Sheets("Süz").Cells(kaplan, "I") Then
Sheets("Süz").Cells(kaplan, "L") = "G"
Else
Sheets("Süz").Cells(kaplan, "L") = "M"
End If
End If
If Sheets("Süz").Cells(kaplan, "L") = "G" Then
Sheets("Süz").Cells(kaplan, "M") = 3
ElseIf Sheets("Süz").Cells(kaplan, "L") = "B" Then
Sheets("Süz").Cells(kaplan, "M") = 1
ElseIf Sheets("Süz").Cells(kaplan, "L") = "M" Then
Sheets("Süz").Cells(kaplan, "M") = 0
End If
kaplan = kaplan + 1
Sheets("Süz").Range("F18") = 1
Sheets("Süz").Cells(kaplan, "F") = WorksheetFunction.Max(Range("F18:F" & kaplan - 1)) + 1
End If
Next
Application.ScreenUpdating = True
MsgBox Sheets("Süz").Range("J1") & " Takımının Maçlarını Aktardım", _
vbInformation, "Bitiş"
End Sub
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,715
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
İhsan bey merhaba,

Öncelikle emeğiniz ve ilginiz için teşekkür ederim, sağolun,

Küçük bir sorun var,

F sütunundaki sıra no.su F18 den başlamalı, hali hazırda sıra no vermeye F19 dan başlıyor, kod'da düzeltilecek yer neresidir ?

Teşekkür ederim.
 
İ

İhsan Tank

Misafir
İhsan bey merhaba,

Öncelikle emeğiniz ve ilginiz için teşekkür ederim, sağolun,

Küçük bir sorun var,

F sütunundaki sıra no.su F18 den başlamalı, hali hazırda sıra no vermeye F19 dan başlıyor, kod'da düzeltilecek yer neresidir ?

Teşekkür ederim.
Üstteki kodu güncelledim.
Kusura bakmayın o noktayı atlamışım
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,715
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
Üstteki kodu güncelledim.
Kusura bakmayın o noktayı atlamışım
İhsan bey tekrar merhaba,

Rica ederim, kusur ne kelime,

Süper Ligden takım seçildiğinde F52 ye 35 yazıyor, F52'nin boş olması gerekir (malum SüperLig 34 hafta),

Çok sorun değil o satırı beyaz renk ile aşabilirim, bilginiz olsun istedim,

Tekrar teşekkür ederim,

Saygılarımla.
 
İ

İhsan Tank

Misafir
İhsan bey tekrar merhaba,

Rica ederim, kusur ne kelime,

Süper Ligden takım seçildiğinde F52 ye 35 yazıyor, F52'nin boş olması gerekir (malum SüperLig 34 hafta),

Çok sorun değil o satırı beyaz renk ile aşabilirim, bilginiz olsun istedim,

Tekrar teşekkür ederim,

Saygılarımla.
Sorun Genel Sayfasında bazı takımları 4. defa eşleştirmişsiniz. mesela
GS ile İbb 1 senede 4 defa karşılaşıyorlar.
Ankaragücü ise Eskişehir ile
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,715
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Altın Üyelik Bitiş Tarihi
04-01-2026
İhsan bey merhaba,

Fikstürü uyarınız gereği düzenledim,

Teşekkür ederim.
 
Üst