mustafa
Altın Üye
- Katılım
- 8 Eylül 2004
- Mesajlar
- 237
- Excel Vers. ve Dili
- Excel 365 - Türkçe
- Altın Üyelik Bitiş Tarihi
- 14-01-2026
Merhabalar,
Ekli dosyada Basketbol sayfasında herhangi bir maça tıklayıp Takım Seç butonuna tıklayınca o maçlar Ana Sayfa D2-E2 hücrelerine geliyor. Sonra Maçları Getir butonuna tıklayınca o iki takımın o maçtan önce oynadıkları maçlar geliyor.
Benim istediğim şu;
Maçları Getir butonuna tıklayınca aynı ligde oynanan maçlar gelsin. Aşağıdaki kodda ne gibi değişiklik ya da ekleme yapmak gerek? Bu benim excel bilgimi çok fazla aşıyor. Yardımcı olacak ustalara şimdiden teşekkür ederim.
Ekli dosyada Basketbol sayfasında herhangi bir maça tıklayıp Takım Seç butonuna tıklayınca o maçlar Ana Sayfa D2-E2 hücrelerine geliyor. Sonra Maçları Getir butonuna tıklayınca o iki takımın o maçtan önce oynadıkları maçlar geliyor.
Benim istediğim şu;
Maçları Getir butonuna tıklayınca aynı ligde oynanan maçlar gelsin. Aşağıdaki kodda ne gibi değişiklik ya da ekleme yapmak gerek? Bu benim excel bilgimi çok fazla aşıyor. Yardımcı olacak ustalara şimdiden teşekkür ederim.
Kod:
Sub getir_D_içerde()
Dim S1 As Worksheet, S2 As Worksheet
Dim a_sat As Long, mac_No As Variant, bulunanno As Long
Dim aranan As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set S1 = ThisWorkbook.Worksheets("Basketbol")
Set S2 = ThisWorkbook.Worksheets("Ana Sayfa")
sonn = S1.Range("e65536").End(xlUp).Row + 1
a_sat = S2.Range("A1")
mac_No = Right((S1.Range("AF" & a_sat)), 2)
If Not IsNumeric(mac_No) Then mac_No = Right((S1.Range("AF" & a_sat)), 1)
On Error Resume Next
Rem 1.takımın evindeki son beş maçı
S2.Range("b6:x16").ClearContents
For i = 6 To 16
aranan = S2.Cells(2, "d") & "#" & mac_No: bulunanno = 0
bulunanno = WorksheetFunction.Match(aranan, S1.Range("AF1:AF" & sonn), 0)
If bulunanno >= 1 Then
For k = 2 To 24
S2.Cells(i, k - 0) = S1.Cells(bulunanno, k)
Next k
End If
mac_No = mac_No + 1
Next i
Set S1 = Nothing: Set S2 = Nothing
sonn = Empty: mac_No = Empty: a_sat = Empty: bulunanno = Empty: i = Empty: k = Empty
aranan = vbNullString
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
Ekli dosyalar
-
1.5 MB Görüntüleme: 4