Altın Euro ve Dolar Gün İçinde En Düşük ve En Yüksek Değerler

ALTINYAYLA

Altın Üye
Katılım
26 Nisan 2005
Mesajlar
284
Excel Vers. ve Dili
Office 2016 Türkçe
Merhabalar Arkadaşlar Benim ödemem gereken 3 değişik kalemden borçlarım var. Altın Euro ve Dolar ve günlük cüzi miktarlarda ödeme yapıyorum. Anlık fiyatları öğrenebileceğim ve (tabi olabilirliği varsa) içinde bulunulan günün en yüksek ve en düşük değerlerinin tek bir sayfaya gün gün her satır bir gün olmak üzere otomatik eklenmesini istiyorum. Bu konuda bilgisi olan arkadaşlarımın bilgilerinden istifade etmek istiyorum. Bu mümkünmüdür... Eğer mümkünse müteşekkir olurum. bu örnek dosyada 3 sayfa var ben bunu tek sayfada olmasını istiyorum ve euro dolar altın üçüde aynı sayfada...
 

Ekli dosyalar

Son düzenleme:

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu kodu bir dene verileri sayfaya alıyor buradan da yapmak istediğinizi sonradan yaparsınız.

PHP:
Sub deneme()

Dim URL As String
Dim ie As Object

Range("A2:E5000").ClearContents
sat = 1

URL = "https://dovizborsa.com/altin/"
Set ie = CreateObject("InternetExplorer.Application")


ie.Navigate URL
ie.Visible = 1
ie.Width = 400
ie.Height = 850
ie.Left = 10
ie.Top = 0

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

Set veriCollection = ie.document.getElementsByTagName("p")

For Each veri In veriCollection

If veri.className = "-cd-" Then
sat = sat + 1
Cells(sat, 1) = Replace(Replace(WorksheetFunction.Trim(veri.InnerText), Chr(13), ""), Chr(10), " ")
End If
If veri.className = "-nm-" Then
Cells(sat, 2) = Replace(Replace(WorksheetFunction.Trim(veri.InnerText), Chr(13), ""), Chr(10), " ")
End If
If veri.className = "-by-" Then
Cells(sat, 3) = Replace(Replace(WorksheetFunction.Trim(veri.InnerText), Chr(13), ""), Chr(10), " ") * 1
End If
If veri.className = "-sl-" Then
Cells(sat, 4) = Replace(Replace(WorksheetFunction.Trim(veri.InnerText), Chr(13), ""), Chr(10), " ") * 1
End If
If veri.className = "-cl-" Then
Cells(sat, 5) = Replace(Replace(WorksheetFunction.Trim(veri.InnerText), Chr(13), ""), Chr(10), " ") * 1
End If

Next

ie.Quit: Set ie = Nothing


MsgBox ("Bitti  ")
End Sub
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Halit Bey;

Bu tür web sayfası yapılarında IE yerine XMLHTTP kullanmak hem kodu hızlandırır, hem IE nedeniyle oluşabilecek hatalarından kurtulmuş olursunuz.

.
 

ALTINYAYLA

Altın Üye
Katılım
26 Nisan 2005
Mesajlar
284
Excel Vers. ve Dili
Office 2016 Türkçe
Halit hocam benim amacım bahsettiğim işi tek bir sayfada yapmak 3 sayfayı teke düşürmek bu birinci husus bir diğer husus ise bu kodu nereye yapıştıracağım. Alakanız için şimdiden teşekkür ederim..
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu dosyayı irdeleyiniz.
Veriler sayfa1 alınıyor siz sayfa2 ve sayfa3 e ne gibi işlem yapmak istiyorsanız örnek dosya ile açıklamaya çalışın burada en yüksek veya en düşük hangisi oluyor en düşük veya en yüksek hesaplarken hangi veriler hesaplanıyor.
PHP:
Sub veri_al_1()

Dim xmlhttp As Object, URL As String

Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
URL = "https://dovizborsa.com/altin/"

xmlhttp.Open "GET", URL, False
xmlhttp.send

hucre = xmlhttp.responseText

veri1 = ">"
veri2 = "="
veri3 = "</p>"
veri4 = """"
veri5 = ""

ara1 = "-row _"
ara2 = "-nm-"
ara3 = "-by-"
ara4 = "-sl-"
ara5 = "-cl-"

Range("A1:E5000").ClearContents
Range("A1:E1") = Array("Kod", "ALTIN", "ALIŞ", "SATIŞ", "KAPANIŞ")
sat = 2

deg1 = Split(hucre, ara1)
If UBound(deg1) > 0 Then
For k = 1 To UBound(deg1) - 1

deg2 = Split(deg1(k), veri1)
If UBound(deg2) > 0 Then
Cells(k + 1, 1).Value = Replace(Split(deg2(0), veri2)(1), veri4, veri5)
End If

deg3 = Split(deg1(k), ara2)
If UBound(deg3) > 0 Then
Cells(k + 1, 2).Value = Replace(Split(deg3(1), veri3)(0), veri4 & veri1, veri5)
End If

deg4 = Split(deg1(k), ara3)
If UBound(deg4) > 0 Then
Cells(k + 1, 3).Value = Replace(Split(deg4(1), veri3)(0), veri4 & veri1, veri5) * 1
End If

deg5 = Split(deg1(k), ara4)
If UBound(deg5) > 0 Then
Cells(k + 1, 4).Value = Replace(Split(deg5(1), veri3)(0), veri4 & veri1, veri5) * 1
End If

deg6 = Split(deg1(k), ara5)
If UBound(deg6) > 0 Then
Cells(k + 1, 5).Value = Replace(Split(deg6(1), veri3)(0), veri4 & veri1, veri5) * 1
End If

sat = sat + 1
Next k
End If
MsgBox "İşlem Tamam"
 

Ekli dosyalar

Son düzenleme:

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,270
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Merhaba;

Sanırım gerekli olan veriler sadece, spot piyasada Dolar ve Euro ile Altın'ın Dolar bazında Ons değeri ...

O zaman, aşağıdaki kod bu verilerle ilgili bilgileri (alış, satış, kapanış, değişim oranı, son işlem saati) https://dovizborsa.com/altin/ adresinden çeker.

Bu kod tabii ki, soruyu soran arkadaşın beklediği cevap değil, çünkü o zaten bu verileri bir şekilde Web Query ile sayfaya alıyor. Aşağıdaki kod ise; Halit Bey gibi söz konusu dış veri almaya alternatif bir yaklaşım oluşturmak, işi hızlandırmak için hazırlanmıştır.

Kod:
Sub GetData()
    ' Haluk-19/08/2018
    '
    Dim HTTP As Object, HTML As Object
    Dim URL As String
    Dim USDTRY As Object, EURTRY As Object, XAUUSD As Object
   
    Range("A1:G" & Rows.Count) = Empty
   
    URL = "https://dovizborsa.com/altin"
   
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    Set HTML = CreateObject("HTMLFILE")
   
    HTTP.Open "GET", URL, False
    HTTP.send
   
    If HTTP.Status = 200 Then
        HTML.body.innerHTML = HTTP.responseText
        
        Range("B1:G1") = Array("Kod", "Alış", "Satış", "Kapanış", "%", "Saat")
        Range("B1:G1").Font.Bold = True
        
        Set USDTRY = HTML.getelementByID("USDTRY")
        Range("A2") = USDTRY.Children(0).Children(0).Title
        Range("B2") = USDTRY.Children(0).innerText
        Range("C2") = USDTRY.Children(1).innerText + 0
        Range("D2") = USDTRY.Children(2).innerText + 0
        Range("E2") = USDTRY.Children(3).innerText + 0
        Range("F2") = USDTRY.Children(4).innerText + 0
        Range("G2") = USDTRY.Children(5).innerText
        
        Set EURTRY = HTML.getelementByID("EURTRY")
        Range("A3") = EURTRY.Children(0).Children(0).Title
        Range("B3") = EURTRY.Children(0).innerText
        Range("C3") = EURTRY.Children(1).innerText + 0
        Range("D3") = EURTRY.Children(2).innerText + 0
        Range("E3") = EURTRY.Children(3).innerText + 0
        Range("F3") = EURTRY.Children(4).innerText + 0
        Range("G3") = EURTRY.Children(5).innerText
        
        Set XAUUSD = HTML.getelementByID("XAUUSD")
        Range("A4") = XAUUSD.Children(0).Children(0).Title
        Range("B4") = XAUUSD.Children(0).innerText
        Range("C4") = XAUUSD.Children(1).innerText + 0
        Range("D4") = XAUUSD.Children(2).innerText + 0
        Range("E4") = XAUUSD.Children(3).innerText + 0
        Range("F4") = XAUUSD.Children(4).innerText + 0
        Range("G4") = XAUUSD.Children(5).innerText
    End If
    
    Range("A1:G4").Columns.AutoFit
    Set USDTRY = Nothing
    Set EURTRY = Nothing
    Set XAUUSD = Nothing
    Set HTML = Nothing
    Set HTTP = Nothing
End Sub
Not: Eğer sayfadaki tüm verilerin alınması istenseydi, o zaman hazırlanacak bir For-Next döngüsü ile tüm veriler alınabilirdi.

.
 
Son düzenleme:

netzone

Altın Üye
Katılım
10 Mayıs 2006
Mesajlar
789
Excel Vers. ve Dili
🅾🅵🅵🅸🅲🅴
⎝2019 32 Bit 𝙏𝙍⎠
🆆🅸🅽🅳🅾🆆🆂
⎝10 64 Bit 𝙏𝙍⎠
Son düzenleme:

ALTINYAYLA

Altın Üye
Katılım
26 Nisan 2005
Mesajlar
284
Excel Vers. ve Dili
Office 2016 Türkçe
kodları ekleyip dosyanın çalışır halini paylaşırmısın netzone mümkünse...
 

ALTINYAYLA

Altın Üye
Katılım
26 Nisan 2005
Mesajlar
284
Excel Vers. ve Dili
Office 2016 Türkçe
Haluk bey emeklerin için çok teşekkür ederim. Ancak benim istediğim bu değil, benim ilk paylaştığım dosyadaki altın için olanları € ve $ için de almak. yani günde kaç defa yenilenirse yenilensin sadece 1 en düşük ve bir en yüksek veriyi alıyor günde 1 defa ama... Yanılmıyorsam ilk paylaşımımdaki örnek dosyanın kodlarının mimarı Korhan Ayhan Üstadımızdı. Selamlar iyi bayramlar.
 
Son düzenleme:

ALTINYAYLA

Altın Üye
Katılım
26 Nisan 2005
Mesajlar
284
Excel Vers. ve Dili
Office 2016 Türkçe
İlk sayfadaki dosya sadece altın için euro ve dolar da eklenecek.
 

ALTINYAYLA

Altın Üye
Katılım
26 Nisan 2005
Mesajlar
284
Excel Vers. ve Dili
Office 2016 Türkçe
Selam Arkadaşlar, aşağıdaki koda göre Altın Kur, Dolar Kur ve Euro Kur Sayfalarını kullanıyorum. Bunların yanısıra "Gümüş Kur" sayfası da oluşturup fiyatları takip etmek istiyorum. Bu koda gerekli düzenlemeyi yapmak için yeteri kadar kod bilgim bulunmadığından ilgili koda düzenlemeyi yaparsanız sevinirim...

----------------------------------------------------------

Private Sub Worksheet_Calculate()
Dim S1, S2, S3 As Worksheet, Bul1, Bul2, Bul3 As Range, Sat1, Sat2, Sat3 As Long
Dim Mak1, Mak2, Mak3 As Double, Min1, Min2, Min3 As Double

Set wf = WorksheetFunction: Set S1 = Sheets("Dolar Kur")
Set S2 = Sheets("Euro Kur"): Set S3 = Sheets("Altın Kur")

Set Bul1 = S1.Range("A:A").Find(Date)
Set Bul2 = S2.Range("A:A").Find(Date)
Set Bul3 = S3.Range("A:A").Find(Date)

If Not Bul1 Is Nothing Then
Min1 = wf.Min(S1.Range("B" & Bul1.Row, "C" & Bul1.Row), [C2])
Mak1 = wf.Max(S1.Range("B" & Bul1.Row, "C" & Bul1.Row), [C2])
Bul1.Offset(, 1) = Min1: Bul1.Offset(, 2) = Mak1
Else
Sat1 = S1.Cells(Rows.Count, 1).End(3).Row + 1
S1.Cells(Sat1, 1) = Date: S1.Cells(Sat1, 2) = [C2]
End If
If Not Bul2 Is Nothing Then
Min2 = wf.Min(S2.Range("B" & Bul2.Row, "C" & Bul2.Row), [C3])
Mak2 = wf.Max(S2.Range("B" & Bul2.Row, "C" & Bul2.Row), [C3])
Bul2.Offset(, 1) = Min2: Bul2.Offset(, 2) = Mak2
Else
Sat2 = S2.Cells(Rows.Count, 1).End(3).Row + 1
S2.Cells(Sat2, 1) = Date: S2.Cells(Sat2, 2) = [C3]
End If
If Not Bul3 Is Nothing Then
Min3 = wf.Min(S3.Range("B" & Bul3.Row, "C" & Bul3.Row), [C4])
Mak3 = wf.Max(S3.Range("B" & Bul3.Row, "C" & Bul3.Row), [C4])
Bul3.Offset(, 1) = Min3: Bul3.Offset(, 2) = Mak3
Else
Sat3 = S3.Cells(Rows.Count, 1).End(3).Row + 1
S3.Cells(Sat3, 1) = Date: S3.Cells(Sat3, 2) = [C4]
End If
End Sub
 

ALTINYAYLA

Altın Üye
Katılım
26 Nisan 2005
Mesajlar
284
Excel Vers. ve Dili
Office 2016 Türkçe
Kod yazan ustalardan Yardım talep ediyorum.
 
Üst