Soru web'den otomatik veri çekme

nes432 · 13 Ağustos 2020

Merhaba,
https://www.xe.com/currencytables/
adresindeki kurları excele günlük çekmek istiyorum ancak otomatik oluşturduğum makro hangi gün oluşturuluyorsa o günün yani geçmiş tarihin verilerini çekiyor. Günlük kurları çekebilecek yeni bir makro oluşturabilir miyiz. Teşekkür ediyorum.

ismailem · 13 Ağustos 2020

nes432' Alıntı:
Merhaba,
https://www.xe.com/currencytables/
adresindeki kurları excele günlük çekmek istiyorum ancak otomatik oluşturduğum makro hangi gün oluşturuluyorsa o günün yani geçmiş tarihin verilerini çekiyor. Günlük kurları çekebilecek yeni bir makro oluşturabilir miyiz. Teşekkür ediyorum.

verilerin çekileceği link adres kısmını şu şekilde yaparsınız:
"https://www.xe.com/currencytables/?from=USD&date=" & Year(Date) & "-" & Month(Date) & "-" & Day(Date)

nes432 · 13 Ağustos 2020

ismailem' Alıntı:
verilerin çekileceği link adres kısmını şu şekilde yaparsınız:
"https://www.xe.com/currencytables/?from=USD&date=" & Year(Date) & "-" & Month(Date) & "-" & Day(Date)

teşekkür ederim cevap için ancak yine olmuyor, bir önceki sayfadaki verileri alıyor.

ismailem · 13 Ağustos 2020

nes432' Alıntı:
teşekkür ederim cevap için ancak yine olmuyor, bir önceki sayfadaki verileri alıyor.

önce oluşturduğunuz makroyu paylaşınız üzerinde değişiklik yaparız.

nes432 · 13 Ağustos 2020

Private Sub Workbook_Open()

Sub Makro2()
'
' Makro2 Makro
'

'
Range("L2").Select
ActiveCell.FormulaR1C1 = "https://www.xe.com/currencytables/"
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.xe.com/currencytables/?from=USD&date=2020-08-12", Destination _
:=Range("$A$1"))
'.CommandType = 0
.Name = "?from=USD&date=2020-08-12_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """historicalRateTbl"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Range("A2

3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("A12").Select
'Cells.Find(What:="IQD,", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Cells.Find(What:="IQD", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("A29

29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
ActiveWindow.SmallScroll Down:=0
'Selection.Find(What:="AZN", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'Selection.FindNext(After:=ActiveCell).Activate
Range("D24").Select
Cells.FindNext(After:=ActiveCell).Activate
Range("A117

117").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("B107").Select
Cells.Find(What:="XAF", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("A59

59").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("B49").Select
Cells.Find(What:="XOF", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("A49

49").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("A53").Select
Cells.Find(What:="UKRA", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("A51

51").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("B55").Select
Cells.Find(What:="ANGOLA", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("A78

78").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("B72").Select
Cells.Find(What:="CFA", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
Cells.Find(What:="MO", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
Cells.FindNext(After:=ActiveCell).Activate
Cells.Find(What:="DİR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
Range("B44").Select
Cells.Find(What:="MAD", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("A46

46").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("C40").Select
ActiveWindow.SmallScroll Down:=-36
Range("A25

25").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Rows("4:168").Select
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add(Range("A4:A168"), _
xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(169, _
208, 142)
ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add(Range("A4:A168"), _
xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
192, 0)
With ActiveWorkbook.Worksheets("Sayfa1").Sort
.SetRange Range("A4:L168")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F12").Select
End With
End Sub

ismailem' Alıntı:
önce oluşturduğunuz makroyu paylaşınız üzerinde değişiklik yaparız.

otomatik oluşturulmuş bir makro o nedenle fazla uzun

ismailem · 13 Ağustos 2020

Sub verial()
Columns("A:L").Select
Selection.Delete Shift:=xlToLeft
Range("L2").Select
ActiveCell.FormulaR1C1 = "https://www.xe.com/currencytables/"
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.xe.com/currencytables/?from=USD&date=" & Year(Date) & "-" & IIf(Len(Month(Date)) = 1, "0" & Month(Date), Month(Date)) & "-" & IIf(Len(Day(Date)) = 1, "0" & Day(Date), Day(Date)), Destination _
:=Range("$A$1"))
.Name = "?from=USD&date=" & Year(Date) & "-" & IIf(Len(Month(Date)) = 1, "0" & Month(Date), Month(Date)) & "-" & IIf(Len(Day(Date)) = 1, "0" & Day(Date), Day(Date)) & "_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """historicalRateTbl"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
Range("A2