Soru Nesine Sportoto Kupon Seçtirme, Checked = TRUE kontrolü

[sc242019]

Değerli büyüklerim ve arkadaşlar.

Sizin için basit bir soru olabilir fakat ben işin içinden çıkamadım.

Nesine adresindeki sportoto bölümünden toto seçimi yaptırmaya çalışıyorum. fakat sitenin kaynağındaki "ID" değeri aynı olduğu için hep aynı satıra bilgi ekliyor.

Örnek Kodum :

ie.Document.getElementById(Range("KS2")).Checked = True
ie.Document.getElementById(Range("KT2")).Checked = True
ie.Document.getElementById(Range("KU2")).Checked = True
ie.Document.getElementById(Range("KV2")).Checked = True

Örnek Kaynak :

<input id="00" type="checkbox" data-group="0" data-column="0" data-row="1">
<input id="00" type="checkbox" data-group="0" data-column="0" data-row="2">

yaptığımda ilk kolon başarılı şekilde seçiyor. ama belirttiğim gibi alttaki kolonlarında ID değeri aynı olduğu için. hepsini üstteki kolona işaretliyor.

yardımcı olurmusunuz ?

 

[sc242019]

Konu Güncel , Arkadaşlar.

 

[sc242019]

Konu Günceldir. Arkadaşlar Nesine'de Sportoto Seçimi Yaptırmak için Checkbox kontrolü gerekiyor sadece buna bir Allahın sevgili kulu el atarmı ?

 

[halit3]

web adresini yazmamışsın böyle olunca kimseden cevap gelmez.
şöyle bir şeyler yapmalısınız.

IE.Document.getElementById(Range("KS2"))(0).Checked = True
IE.Document.getElementById(Range("KS2"))(1).Checked = True
IE.Document.getElementById(Range("KS2"))(2).Checked = True

 

[sc242019]

Hocam cevabınızdan dolayı çok teşekkür ederim. Pazar günü yeni program yayınlanacak seçim ekranı çıkacak karşımıza.

verdiğiniz kodu deneyeceğim. ben excel tablolarına şartlara uygun , belirtilen sitedeki ID değerlerini yazdırdım bu şekilde seçim yaptırmak istedim hep en üst satırdaki girdiler sağlandı fakat diğer ID lere geçemedi.

Bu işlemi eğer bu kodlarla çözebilirsek çok sağolun. saygılar.

 

[sc242019]

Halit hocam malesef verdiğiniz kod ile seçimler yapılamıyor.

siz bir denermisiniz toto programı yayınlanmış. tek yapmanız gereken VBA ile toto seçimi yaptırmak bukadar zor olmamalı ya

Destekğiniz için şimdiden teşekkür ederim. Bekliyorum.

 

[halit3]

Web sitesinin adreseni niye yazmıyorsunuz ayrıca ekran görüntüsü de ekleyin

 

[sc242019]

Hocam yasaktır diye yazmamıştım başka sitelerde öyle oluyordu kusura bakmayın.
https://nesine.com/sportoto


Bu dört kolonda bu şekilde exceldeki ayarlar ile otomatik özel seçimler yapsın yazılım kendisi kullanıcı ile bağlı kalmadan.

"ilk dört kolon tamamlanınca kaydet butonuna tıklattırabilirim. "

 

[halit3]

Bu kod hepsini birden işaretliyor

Sub veri()
Dim URL As String

Dim IE As Object

Range("A1:A5000").ClearContents

URL = "https://www.nesine.com/sportoto"
Set IE = CreateObject("InternetExplorer.Application")

With IE
.navigate URL

IE.Visible = 1
IE.Width = 800
IE.Height = 850
IE.Left = 10 '250
IE.Top = 0

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

Set objCollection = IE.Document.getElementsByTagName("input")
For Each ddr In objCollection
If IsNumeric(ddr.ID) = True Then
k = k + 1
Cells(k, 1) = ddr.ID
Cells(k, 2) = ddr.Name
ddr.Checked = True
End If
Next
'IE.Quit: Set IE = Nothing
End With


MsgBox ("Bitti  ")
End Sub

 

[sc242019]

Eywallah hocam sizin sayenizde olacak. Çok teşekkür ederim

 

[halit3]

Ben şöyle bir tablo hazırladım sarı renkli yerler veb sitesindeki karelerle aynı sarı alana 1 yazdığınızda bir yazılı kareye eşleşen web sitesindeki kareye tik koyuyor.

Sub veri20()
Dim URL As String

Dim IE As Object

URL = "https://www.nesine.com/sportoto"
Set IE = CreateObject("InternetExplorer.Application")

With IE
.navigate URL

IE.Visible = 1
IE.Width = 800
IE.Height = 850
IE.Left = 10
IE.Top = 0

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

sat = 2
sut = 1
Set objCollection = IE.Document.getElementsByTagName("input")
For Each ddr In objCollection
If IsNumeric(ddr.ID) = True Then

If sut = 13 Then
sut = 1
sat = sat + 1
End If
sut = sut + 1
If Cells(sat, sut) = 1 Then
ddr.Checked = True
End If
End If
Next
'IE.Quit: Set IE = Nothing
End With

MsgBox ("Bitti  ")
End Sub

 

[sc242019]

Tamamdır bu hocam bilginize sağlık . Elleriniz Dert Görmesin.

 

[halit3]

Bu kod da farklı ekran görüntüsünü de ekliyorum.

Sub veri20()


Range("B3:F17").ClearContents
Range("A1").ClearContents


Dim URL As String

Dim IE As Object

URL = "https://www.nesine.com/sportoto"
Set IE = CreateObject("InternetExplorer.Application")

With IE
.Navigate URL

IE.Visible = 1
IE.Width = 800
IE.Height = 850
IE.Left = 10
IE.Top = 0

Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop


For Each tb In IE.Document.getElementsByTagName("div")
For Each bb In tb.getElementsByTagName("Table")
For Each tr In bb.getElementsByTagName("thead")
For Each ts In tr.getElementsByTagName("tr")
For Each td In ts.getElementsByTagName("th")
Cells(1, 1) = td.innerText
GoTo atla3
Next td
Next ts
Next tr
GoTo atla3
Next bb
Next tb

atla3:


sat = 2

For Each tb In IE.Document.getElementsByTagName("div")
For Each bb In tb.getElementsByTagName("Table")

For Each tr In bb.getElementsByTagName("tbody")
For Each ts In tr.getElementsByTagName("tr")
sat = sat + 1
sut = 0
For Each td In ts.getElementsByTagName("td")
sut = sut + 1
If sut = 7 Then GoTo atla1
'MsgBox say & Chr(10) & td.innerText

If sut = 3 Then
hucre = td.innerText
deg1 = Split(hucre, "  ")
If UBound(deg1) > 0 Then
Cells(sat, sut) = deg1(0)
End If
Else
Cells(sat, sut) = td.innerText
End If
Next td
atla1:

Next ts
Next tr
GoTo atla2
Next bb
Next tb

atla2:





sat = 3
sut = 6
Set objCollection = IE.Document.getElementsByTagName("input")
For Each ddr In objCollection
If IsNumeric(ddr.ID) = True Then

If sut = 19 Then
sut = 1
sat = sat + 1
End If
sut = sut + 1
If Cells(sat, sut) = 1 Then
ddr.Checked = True
End If
End If
Next
'IE.Quit: Set IE = Nothing
End With

'MsgBox ("Bitti  ")
End Sub

 

[sc242019]

Hepsi işime yarıyor çok teşekkür ederim.

 

[halit3]

İlgili nesnelerin değerleri 20 den 200 e kadar gitmekte

For k = 20 To 200
IE.Document.getElementsByTagName("input")(k).Checked = True
Next k

 

[halil.555]

merhabalar benimde buna benzer birşeye ihtiyacım var ama nasıl yaparım bilmiyorum yardımcı olurmusunuz

ama benimki 4 kolon aynı anda oynamak

örn

1 0 2 0
1 1 1 1
2 1 0 2

bunun gibi aşağıya doğru 15 4 kolon exel e yazınca makro çalıştır diyince nesine.com adresi toto sayfasına otomatik atabilirmi acaba

 

[sc242019]

Halit hocanın paylaştıkları işine yarayacaktır ben kullanıyorum

 

[akselgonzales]

Ben şöyle bir tablo hazırladım sarı renkli yerler veb sitesindeki karelerle aynı sarı alana 1 yazdığınızda bir yazılı kareye eşleşen web sitesindeki kareye tik koyuyor.

Sub veri20()
Dim URL As String

Dim IE As Object

URL = "https://www.nesine.com/sportoto"
Set IE = CreateObject("InternetExplorer.Application")

With IE
.navigate URL

IE.Visible = 1
IE.Width = 800
IE.Height = 850
IE.Left = 10
IE.Top = 0

Do Until IE.readyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

sat = 2
sut = 1
Set objCollection = IE.Document.getElementsByTagName("input")
For Each ddr In objCollection
If IsNumeric(ddr.ID) = True Then

If sut = 13 Then
sut = 1
sat = sat + 1
End If
sut = sut + 1
If Cells(sat, sut) = 1 Then
ddr.Checked = True
End If
End If
Next
'IE.Quit: Set IE = Nothing
End With

MsgBox ("Bitti  ")
End Sub

Ekli dosyayı görüntüle 209336

Hocam merhaba.. ben bu kodu arıyordum uzun süredir. ama dosyayı altın üye olmadığımdan dolayı alamıyorum yardımcı olabilir misiniz.

 

[halil.555]

Halit hocanın paylaştıkları işine yarayacaktır ben kullanıyorum

tamamdır bende kendime göre uyarladım teşekkür ederim cvp ve emek için

 

[aytcgl]

Merhaba

benım excel tablom boyle ıse nasıl duzenlerım kodu saygılarımla