Pistetään tähän S.Mäenalan ketjujen rinnalle tällainen koodipätkäketju. Koska aivan ilmiselvästi VBA-koodaajien määrä palstalla tulee S.Mäenalan kurssin johdosta kasvamaan, niin tällekin ketjulle saattaa, varsinkin tulevaisuudessa, olla käyttöä. Itse kuulun joukkoon joka oppii esimerkin avulla ihan kohtuullisesti ja oletan, että niin tekee moni muukin, joka SM:n kurssille osallistuu. Olen yrityksen ja erehdyksen kautta, tietämättä mitään koodaamisesta, kaivanut netistä koodin pätkiä ja pistänyt parhaat talteen ja saanut aikaan ihmeellisiä "ohjelmakokonaisuuksia". Käytettäneen tässä ketjussa seuraavaa koodia:
1. vain VBA-koodeja tähän ketjuun
2. ei makronauhoituksella tehtyjä koodeja, koska ne kaikki pystyy tekemään itsekin
3. koodi "code"-tägiin
4. perään koodin selväkielinen selostus
Sub ConvertTextToDate()
Range("tähän haluttu solu").Select
Dim Current_Date As Date
Dim Date_String As String
Date_String = ActiveCell.Value
Current_Date = CDate(Date_String)
ActiveCell.Value = Current_Date
End Sub
Muuttaa halutun solun tekstimuodossa olevan päivämäärän Excelin ymmärtämään päivämäärämuotoon.
Dim FindString As String
Dim Rng As Range
FindString = "tähän se merkkijono jota etsitään"
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("tähän se alue, jolta merkkijonoa etsitään")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'Application.Goto Rng, True
Rng.Activate
Else
End If
End With
End If
Hakee halutulta solualueelta haluttua merkkijonoa ja aktivoi solun löydettyään sen.
Re: Excel-koodinpätkiä vedonlyöjälle
Lähetetty:
Kirjoittaja lammpa-1
Internet Exploreria voi myös käskyttää VBA:lla (itse asiassa käytännössä kaikkia Microsoftin ohjelmia voi käskyttää VBA:lla):
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Navigate ActiveCell.Offset(x,y).Hyperlinks(1).Address
Do Until .ReadyState = 4: DoEvents: Loop 'wait until loaded
End With
IE.Quit
IE.Quit
X = aktiivisesta solusta X kpl pystysuunnassa poikkeava solu
Y = aktiivisesta solusta Y kpl sivuttaissuunnassa poikkeava solu
Käskee IE:a surffaamaan ko solussa olevan Hyperlinkin takana olevaan osoitteeseen ja odottaa että sivu on kokonaan ladattu. (Sitten voi käskeä IE:a tekemään jotain muuta....)
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Navigate ActiveCell.Offset(x,y)
Do Until .ReadyState = 4: DoEvents: Loop
End With
IE.Quit
IE.Quit
Käskee IE:a surffaamaan osoitteeseen, joka on tekstimuodossa x-solua alhaalla ja y-solua oikealla aktiivisesta solusta. Miinusmerkillä saa luonnollisesti muutettua surffaussolua ylös tai vasemmalle....
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Navigate "www.ylikerroin.com"
Do Until .ReadyState = 4: DoEvents: Loop
End With
IE.Quit
IE.Quit
Sitten voi tietty käskyttää IE:a surffaamaan johonkin kiinteään osoitteeseen, kuten yllä....
"IE.Quit"-käsky tavataan laittaa aina kahteen kertaan, koska tunnetusti MS-ohjelmat eivät koskaan tee sitä mitä käsketään , eikä IE-objektia haluta jättää taustalle kuluttamaan muistia...
Re: Excel-koodinpätkiä vedonlyöjälle
Lähetetty:
Kirjoittaja lammpa-1
Kun on käskenyt IE:a surffaamaan johonkin osoitteeseen, niin voi käskyttää IE:n valisemaan koko sivun ja kopioimaan sen:
IE.ExecWB 17, 0 ' valitsee koko sivun
IE.ExecWB 12, 2 ' kopioi valinnan
Re: Excel-koodinpätkiä vedonlyöjälle
Lähetetty:
Kirjoittaja lammpa-1
Kun IE on saatu VBA:lla auki, on joskus tarvetta "klikata" jotakin linkkiä avatulla sivulla. No normaaleiden linkkien pinpauttelu ei pitäisi olla ongelma, mutta javascriptillä tehtyjen välilehtien ja/tai nappuloiden painelu voi aiheuttaa päänvaivaa. Näin se käy ja niin se on....
For Each obj In ie.document.all
If InStr(obj.innerHTML, "tähän nappulassa tai välilehdessä oleva teksti") > 0 Then
obj.Click
obj.FireEvent ("onclick")
End If
Next
Re: Excel-koodinpätkiä vedonlyöjälle
Lähetetty:
Kirjoittaja lammpa-1
IE on siitä *askamainen, että se ilmoittaa olevansa valmis (sivu ladattu), vaikkei se oikeasti olekaan... siksi useimmiten, kun käyttää tuossa ylempänä olevaa koodia IE:n avaamiseen ja sieltä tiedon tonkimiseen, niin ei saa muuta kuin harmaita hiuksia, koska VBA kaivaa sivun itselleen HTML-dokumenttina ja vaikka periaatteessa sivun lataus on valmis, ei HTML-dokumentti olekaan vielä latautunut -> VBA kaivaa tyhjää.... siksipä useimmiten kannattaa käyttää tällaista koodia:
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Navigate "www.ylikerroin.com"
Do Until .ReadyState = 4: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:02"))
End With
IE.Quit
IE.Quit
Eli ensin käsketään IE jollekin sivulle ja sitten käsketään odottaa, että sivun lataus on valmis.... ja sitten käsketään odottaa vielä 2 sekuntia, että VBA saa alkaa tonkimaan tietoa. Joillain sivuilla tuota lisäviivästystä ei tarvita, joillain riittää sekunti jotkut tarvii enemmän....
Re: Excel-koodinpätkiä vedonlyöjälle
Lähetetty:
Kirjoittaja lammpa-1
Joillain webbisivuilla on *ittumaisesti "piilotettu" taulukot siten, että niitä ei saakaan IE:n kautta kaivettua. Silloin voidaan mennä pyytämään webbiserveriltä lupaa tonkia suoraan HTML-koodia:
Sub GetOneTable()
Dim Document As Object
Dim StatementTable As HTMLTable
Set Document = CreateObject("HTMLFile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://www.betexplorer.com/soccer/england/conference-premier/", False
.send
Do: DoEvents: Loop Until .readyState = 4
Document.body.innerHTML = .responseText
.abort
End With
Set StatementTable = Document.getElementById("league-summary-next")
With StatementTable
For r = 0 To .Rows.Length - 1
For c = 0 To .Rows(r).Cells.Length - 1
Sheets("Sheet1").Cells(r + 1, c + 1).Value = .Rows(r).Cells(c).innerText
Next c
Next r
End With
End Sub
Toi hässäkkä jossa on r- ja c- kirjaimia "parseroi" eli jaottelee haetun taulukkomuotoisen datan Excelissäkin taulukkomuotoon.
Dim MyRange As Range
For Each MyRange In ActiveSheet.UsedRange
If 0 < InStr(MyRange, Chr(10)) Then
MyRange = Replace(MyRange, Chr(10), "")
End If
Next
For Each MyRange In ActiveSheet.UsedRange
If 0 < InStr(MyRange, Chr(13)) Then
MyRange = Replace(MyRange, Chr(13), "")
End If
Next
Joskus nuo netissä olevat taulukot saattavat sisältää p*skamaisia merkkejä, jotka "sekoittavat" excelin. Nuo Chr(10) ja Chr(13) ovat mm sellaisia. Taitavat olla jotain Unixin rivinvaihtoja tms. Joka tapauksessa nämä merkit aiheuttavat sen, että solussa oleva teksti rivittyy solun sisällä ja sitten on vaikea päästä käsiksi muuhun kuin ekalla rivilla olevaan dataan. Tällä koodin pätkällä nuo "rivinvaihdot" poistetaan, jolloin kaikki solussa oleva data rivittyy ekalle riville ja on normaalisti manipuloitavissa.