- Katılım
- 21 Mart 2008
- Mesajlar
- 232
- Excel Vers. ve Dili
- 2016
- Altın Üyelik Bitiş Tarihi
- 16-07-2023
Ay kısmı çalışmıyor diğerlerinde sorun yok
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
bu kodu bir dene
Kod:Dim puan() As String Sub baslat() 'On Error Resume Next Dim ie As Object Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True If Range("A65536").End(xlUp).Row >= 3 And Range("B65536").End(xlUp).Row >= 3 Then 'Herhangi bir TC ve doğum tarihi değeri girilmişse devam edilecek For a = 3 To Range("A65536").End(xlUp).Row 'Girilen TC no adedi kadar for döngüsü (TC no değerleri 3. satırdan itibaren yazılıyor. Bu nedenle döngü 3 den başlıyor) If Cells(a, 1).Value > 0 And Cells(a, 2).Value > 0 Then 'TC ve doğum tarihi birlikte doluysa devam et. ie.navigate "http://sonuc.meb.gov.tr/" Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop ie.document.getElementById("TCNO").Value = Cells(a, 1).Value ie.document.getElementById("TCNO").FireEvent "onchange" For t = 1 To ie.document.all("GUN").Length - 1 If ie.document.all.GUN(t).Text = Format(Cells(a, 2).Value, "dd") Then ie.document.all("GUN").Focus ie.document.all("GUN").selectedIndex = t Do Until ie.readyState = 4: DoEvents: Loop Do While ie.Busy: DoEvents: Loop Exit For End If Next t For s = 1 To ie.document.all("AYI").Length - 1 If ie.document.all.AYI(s).Text = Format(Cells(a, 2).Value, "mm") Then ie.document.all("AYI").Focus ie.document.all("AYI").selectedIndex = s Do Until ie.readyState = 4: DoEvents: Loop Do While ie.Busy: DoEvents: Loop Exit For End If Next s For t = 1 To ie.document.all("YIL").Length - 1 If ie.document.all.YIL(t).Text = Format(Cells(a, 2).Value, "yyyy") Then ie.document.all("YIL").Focus ie.document.all("YIL").selectedIndex = t Do Until ie.readyState = 4: DoEvents: Loop Do While ie.Busy: DoEvents: Loop Exit For End If Next t 'ie.document.getElementById("DOGUMTARIHI").Value = Format(Cells(a, 2).Value, "dd") & "." & Format(Cells(a, 2).Value, "mm") & "." & Format(Cells(a, 2).Value, "yyyy") 'Tarih textbox'a giriliyor ie.document.getElementsByName("Submit")(0).Click Do While ie.Busy Or ie.readyState <> 4: DoEvents: Loop Cells(a, 3).Value = ie.document.getElementsByTagName("table")(0).Children(0).Children(1).Children(1).innerText Cells(a, 3).Value = Cells(a, 3).Value & " " & ie.document.getElementsByTagName("table")(0).Children(0).Children(2).Children(1).innerText puan() = Split(ie.document.getElementsByTagName("table")(1).Children(0).Children(0).Children(1).innerText, ",") Cells(a, 4).Value = puan(0) & "," & puan(1) Cells(a, 5).Value = ie.document.getElementsByTagName("table")(1).Children(0).Children(1).Children(1).innerText 'Cells(a, 6).Value = ie.document.getElementsByTagName("table")(1).Children(0).Children(2).Children(1).innerText sut = 7 For k = 1 To 6 Cells(a, sut).Value = ie.document.getElementsByTagName("table")(2).Children(0).Children(k).Children(1).innerText Cells(a, sut + 1).Value = ie.document.getElementsByTagName("table")(2).Children(0).Children(k).Children(2).innerText Cells(a, sut + 2).Value = ie.document.getElementsByTagName("table")(2).Children(0).Children(k).Children(3).innerText 'Cells(a, sut + 3).Value = ie.document.getElementsByTagName("table")(2).Children(0).Children(k).Children(4).innerText sut = sut + 3 Next k Else Cells(a, 3).Value = "EKSİK GİRİŞ" End If ie.Quit: Set ie = Nothing Next Else MsgBox "En az bir adet TC ve doğum tarihi değeri girmelisiniz." Exit Sub End If MsgBox "İşlem Bitti" ' End Sub