Keskustelu: Ohjelmointikysymykset: VBA: Excel (VB) Vertailu

Moi

Tarvitsisin pientä vinkkiä miten solun sisältöä voitaisiin verrata toisen taulukon sisältöön ja kopioida oikean nimen löytyessä viereisen solun arvo. Onnistuuko tämä makroja hyväksi käyttäen vai tarvitankoo VB-kielen tuntemusta?
Onkohan mahdollinen ohjelma vaikea tehdä näin jonkun verran VB käyttäneeltä henkilöltä.

Moi OmenaJunnu!

laita työkirjan tauluun kometopainike-ohjausobjekti ja iske allaoleva simppeli koodi sen nappulan taakse...tutki - säädä - ja tee oma versiosi hieman dynaamisemmaksi...

Private Sub CommandButton1_Click()

'määritellään paikalliset muuttujat
Dim osoite As String, numerot As String, luku As Long
Dim kirjaimet As Long, i As Long, j As Long

'eliminoidaan näytön jatkuva vilkkuminen
Application.ScreenUpdating = False

'napataan viimeisen, arvon sisältävän solun, osoite merkki-
'jonomuttujaan poistaen siitä samalla dollarin merkki
osoite = Replace(Sheets(2).Cells.SpecialCells(xlCellTypeLastCell).Address, "$", "")

'jos työkirjan taulu jonka indeksi = 2 (norm "Taul2")
'on tyhjä annetaan ilmoitus ja poistutaan aliohjelmasta
If osoite = Empty Then
  MsgBox Sheets(2).Name & " on tyhjä": Exit Sub
End If

'määritellän Range-tyyppinen objekti (alue)
Dim alue As Range

'asetetaan objektin solualue
Set alue = Sheets(2).Range("A1:" & osoite)

'napataan alueen viimeisen sarakkeen sijainti ja sijoitetaan
'saatu arvo long-tyyppiseen kokonaislukumuuttujaan
kirjaimet = alue.Columns(alue.Columns.Count).Column

'poimitaan silmukassa merkkijonomuuttujasta (osoite) numeeriset merkit
'ja sijoitetaan saadut arvot merkijonomuuttujaan (numerot)
For i = 1 To Len(osoite)

If IsNumeric(Mid(osoite, i, 1)) Then
numerot = numerot & Mid(osoite, i, 1)
End If

Next i

'käännetään merkkijonomuuttujan (numerot) arvo kokonaisluvuksi
'ja sijoitetaan arvo samalla long-tyyppiseen kokonaislukumuuttujaan
luku = CLng(numerot)

' määritellään objektimuuttuja (solu)
Dim solu

'annetaan kokonaislukumuuttujalle alkuarvo
i = 1

'tutkitaan silmukassa taulun(2) solualueen A1 - viimeinen arvon sisältävä solu...**
For Each solu In Sheets(2).Range("A1:" & Replace(Sheets(2).Cells.SpecialCells(xlCellTypeLastCell).Address, "$", ""))

'kasvatetaan silmukan jokaisella kierroksella sarakeindeksilaskurina
'toimivan kokonaislukumuuttujan arvoa 1:llä ...
j = j + 1

With solu

'**ja jos solu sisältää arvon ja arvo yhtäsuuri, kuin taulun(1) solun(1,1) sisältämä
'arvo annetaan ilmoitus arvon yhtäsuuruudesta sekä taulun(2) kyseisen solun osoite
If Not IsEmpty(.Value) And .Value = ActiveSheet.Cells(1, 1).Value Then
MsgBox Sheets(2).Name & " solun arvo " & Replace(Sheets(2).Cells(i, j).Address, "$", "") & " on yhtäsuuri, kuin " _
& ActiveSheet.Name & " solun " & Replace(ActiveSheet.Cells(1, 1).Address, "$", "") & " arvo"

'muutoin, jos solu sisältää arvon ja arvo on erisuuri, kuin taulun(1) solun(1, 1) sisältämä
'arvo annetaan ilmoitus arvon erisuuruudesta sekä taulun(2) kyseisen solun osoite
ElseIf IsEmpty(.Value) = False And .Value <> ActiveSheet.Cells(1, 1).Value Then
MsgBox Sheets(2).Name & " solun arvo " & Replace(Sheets(2).Cells(i, j).Address, "$", "") & " on erisuuri, kuin " _
& ActiveSheet.Name & " solun " & Replace(ActiveSheet.Cells(1, 1).Address, "$", "") & " arvo"
End If
End With

'jos silmukassa kokonaislukumuuttujan j arvo on noussut yhtäsuureksi,
'kuin alueen viimeisen sarakkeen sarakeindeksin arvo...
If j = Val(numerot) Then
'nollataan kokonaislukumuuttuja
j = 0

'kasvatetaan rivilaskurina toimivan kokonaislukumuuttujan arvoa 1:llä
'jokaisella silmukan kierroksella
i = i + 1
End If

'jos rivilaskurin arvo on noussut suuremmaksi, kuin solualueen viimeisen
'rivin indeksi pudotetaan muutujan arvo takaisin alkuarvoon
If i > luku Then i = 1

Next

'tuhotaan objekti (alue)
Set alue = Nothing

'sallitaan näytön päivittyminen
Application.ScreenUpdating = True

End Sub

Moikka taas OmenaJunnu!

Kuten olet varmaan huomannut, tällainen haku kannattaa tietysti hoitaa EXCELiin valmiiksi sisällytettyjen vertailuun tarkoitettujen funktioiden avulla...
esim. jos kirjoitat työkirjan tauluun Taul2 soluun B1 seuraavanlaisen kaavan:
=JOS($A1=Taul1!$A1;Taul1!$B1;"")
painat ENTERiä, aktivoit samaisen solun uudestaan, tartut hiirellä solun oikeaan alanurkkaan ilmestyvään 'natsiristiin' ja vedät, hiiren nappi pohjassa, alaspäin, niin Taul2 sarake B:n soluihin ilmestyy Taul1 Sarake B:n vastaavan solun arvo (kaavan osa: ;Taul1!$B1) mikäli Taul2 sarakeessa A sijaitsevan solun arvo = Taul1:n vastaavan solun arvo (kaavan osa: $A1=Taul1!$A1;) muutoin Taul2 saraakkeen B, kuloinkin vertailtavana olevan rivin, soluun tulee tyhjä arvo (kaavan osa: ;"")...
eli siis !-merkin avulla viittaat toisen taulun soluun ja $-mekillä viittaat joko sarkkeeseen ($A1), riviin (A$1) tai absoluuttiseen osoitteeseen ($A$1)

Kiitos neau33 avusta!

Sain vähä uutta tietoa projektista. Pystyyköhän sarakkeesta hakemaan erikseen tekstiä riveiltä jotka ovat Bold:attu?
Hmmm ompa vaikea selvitää.
Muutama rivi samaisen solun sisällä on yhteensä rivejä jotka ovat Bold:attu ja nämä pitäisi kopioida toiseen taulukkoon.

Toinen vaihtoehto oikeiden rivien löytämiseen olisi tyhjät rivit solussa.
Onko tähän olemassa mitään funktiota. Microsoft mukaan uudessa (2007 visva) Excelissä on funktio LASKE.JOS.JOUKKO.
Ongelmana lajittelussa on se kun lajittelee solusta tyhjät rivit niin summat katoavat sillä ne on tehty funktiolla välisumma ja kun laskettavat summat häipyvät niin välisummakin häviää.

Moikka taas OmenaJunnu!

vastauksena tohon Bold'aus jutskaan: pystyy...
& alempaan, että onnistuu Excel-versioilla, jotka on tältä vuosituhannelta,
sekä myös parilla viime vuosituhannen versiolla. Mikäli funktiota ei löydy
valmiina niin se voidaan aina rakennella...

Moi

Törmäsin taas uuteen ongelmaan. Miten teen saan valittua avattavan excel taulukon josta teen vertailun ja mihin vertaillaan. Löysin joitain apuja mutta en saanut toimimaan koodin pätkää. Siis tiedoston käsittelystä olisi kyse.

Onkohan toi excelin VB jotenkin riisuttu verrattuna oikeaan VB?
Minulla on viellä käytössä office lite paketti jossa on vain Word ja Exceli.

OmenaJunnu kirjoitti:

Onkohan toi excelin VB jotenkin riisuttu verrattuna oikeaan VB?

On, joskin yllättävän paljon siinä tuntuu toimivan.
Office-tuotteissahan varsinaisesti on VBA (Visual Basic for Applications), ei pelkkä "VB". Tuota voi käyttää esim. googlettaessa.

Moikka taas OmenaJunnu!

eli siis ne valmiit täpät eivät riitä vaan haluat pelata VBA:lla...

No hyvä testaapa jutskaa sit vaikka tähän tapaan: Avaa työkirja ja klikkaa Töykalut -> Makro -> Nauhoita uusi Makro -> OK. Sit aktivoi vaikkapa Taul2:nen sieltä melko läheltä näytön vasenta alanurkkaa. Klikkaa sit taas Työkalut - > Makro -> Lopeta makron nauhoittaminen. Sit klikkaa vielä kerran Työkalut -> Makro -> Makrot -> Muokkaa. Todennäköistä on että sun makrosi nimi on Makro1
mikäli et ole sisällyttänyt tähän avaamasi työkirjaan aiemmin makroa nimeltä Makro1. Sulje nyt VBE (Visual Basic Editori, jossa ohjelmoidaan VBA-scriptillä, joka muistuttaa monin tavoin aitoa VB:iä). Sit palaa takaisin Taul1:een, laita 1 komentopainike-ohjausobjekti taluun ja klikkaa sit sitä nappulaa ja kirjoita sinne nappulan Click-tapahtumaan: Makro1 sulje taas se editori, poistu siitä suunittelutilasta ja klikkaa sitä nappulaa...

Tyytyisin valmiisiin juttuihin mutta ne eivät varmaan riitä tässä tapauksessa.
Tarkoituksena olisi tehdä makro ja (VPA)-sovellus yhteen xls taulukkoon josta sitten saisi valittua kaksi xls-tiedostoa mitä verrattaisiin toisiinsa. En voi ymmärtääkseni käyttää valmista makroa ainakaan suoraan kun hakemistopolku eroaa luultavammin omastani.
Näistä kahdesta xls-tiedostosta pitäisi sitten kopioida muutamasta taulukosta tiedot makron sisällä pitävään xls-tiedostoon ja sitten viellä vertailla taulukkoja toisiinsa.
Tuntuu, että homma on aika haastava kun en ole kovinkaan paljon koodannut. Koulussa meillä oli vb perusteet mutta siinä oikeastaan kaikki ohjelmointi tietämykseni.

Moikka taas OmenaJunnu!

no eihän tämä sinällään vaadi muuta, kuin mielenkiintoa...

Ekaks: missä vertailtava tiedosto sijaitsee?

- Smalla koneella, samassa profiilissa - ei mitään esteitä
- Smalla koneella, All Users profiilissa - sama juttu, kuin edellisessä
- Intrassa, samalla toimialueella - kansion on oltava jaossa
- Intrassa, eri toimialueella - oltava kirjautumis oikeudet + edelliset
- Internet palvelimella, vapaassa jaossa - ei ongelmia
- Internet palvelimella, rajoitetusti jaossa - oltava kirjautumis oikeudet

Kaikki edellä lueteltu on sellaista, johon ei voi suoraan vaikuttaa Excelillä, mutta nämä asiat on kuitenkin oltava selvillä heti suunnittelun alkuvaiheessa.

Kun kaikki edellinen on otettu huomioon projektille asetettujen vaatimusten valossa niin vertailtavan tiedoston tietojen tuonti/käsittely ei tuota ongelmaa. Mikäli tiedoston luoja on suojannut työkirjan ja/tai taulun/t voi tietyissä tapauksissa olla tarpeellista, että myös salasana on tiedossa.

Tee seuraavanlainen koe:
Avaa uusi työkirja ja kirjoittele ekan rivin soluihin jotain otsikoita.Sijottele niiden otsikoiden alla oleviin soluihin jotain arvoja. Maalaa sit hiirellä se koko alue ja klikkaa: Lisää -> Nimi -> Määritä - kirjoita sit siinä ylemmässä laatikossa joku nimi sille solualueelle klikkaa: OK tallenna vaikkapa työpöydälle ja sulje työkirja. Avaa sit vaikka uusi työkirja ja aktivoi vaikkapa Taul2. Sit klikkaa: Tiedot -> Ulkoiset tiedot -> Luo uusi kysely - tuplaklikkaa lootassa Excel Files klikkaa oikeenpuoleisessa lootassa: Työpöytä, mikäli ei oo jo aktiivisena. Tuplaklikkaa sit siinä vasemmassa lootassa sen tiedoston nimeä, jonka edellä tallensit. Laajenna se puu siitä plussasta siinä vasemmassa lootassa ja siirtele niillä nuolilla sitä kaamaa siihen oikeeseen lootikkoon. Kun olet tyytyväinen niin klikkaa: Seuraava -> Seuraava - Seuraava (tuki sitä lajittelua myöhemmin). Valitse sillä radionappulalla: Palauta tiedot Microsoft Exceliin - ja klikkaa: (tällä ekalla kertaa) OK siinä Tietojen luominen -laatikossa. Klikkaa sit hiiren vasemmalla sen solualueen päällä joka ilmesty siheen tauluun -> klikkaa Tietoalueen ominaisuudet, siinä laatikossa voit sit säädellä miten tiedot päivitellään jne. Tallenna nyt tämä työkirja, mutta älä sulje vielä. Nyt jos rakentelet vaikkapa samansuuntaisen vertailujutskan, kuin tuo aiemmin esittämäni niin alat edistyä.

Kun olet tutustunut tähän toimintoon paremmin niin voit alkaa nauhoitteleen sitä prosessia sillä makronauhurillä ja tutkimaan syntynyttä koodia. Sitten kun alat olla selvillä siitä, millä kohtaa kannattaa alkaa höysteleen toimintoja VBA:lla, niin alat olla hieman pidemmällä. Muista tutkia myös VBE:n helppiä...

Moikka taas OmenaJunnu!

Nyt kun olet löytänyt MsQuery'n ja alat tutkimaan sen mahdollisuuksia niin mitä luultavimpaa on, että herää ajatus -Hitsi ei oo tyhmiä ne sielä Microsoftilla

Moi

Kiitos neau avusta!!

Totta turiset toihan MsQuery on aikasta fiksu vaikka en ole kun raapaissut pintaa viellä.

En ole keksinyt viellä ratkaisua tohon ongelmaan josta koitin kertoa. Nuo tarvittavat excel taulukot saadaan PDMS-Cad ohjelmasta josta määritellään millä nimellä taulukko tallennetaan ja minne.
Mitenkähän tuon laijitteluun saisi ehdon, että käyttäjä määrittäisi paikan mistä taulukko hattaisiin?

Sain jonkullaisen käsityksen miten tiedoston saa avattua mutta miten hakemistopolun tiedon saa tallennettua muistipaikkaan. Koitin tutkia helppiä ja googlettaa tuota mutta en löytänyt ratkaisua.
Alla on käyttämäni koodinpätkä.

Private Sub CommandButton1_Click()
Dim Tiedosto As Object
fileToOpen = Application _
    .GetOpenFilename("Excel Files (*.xls), *.xls")
If fileToOpen <> False Then
    MsgBox "Alkuperäinen työkirja on määritelty " & fileToOpen

End If
End Sub

Mod. lisäsi kooditagit

Oheisella koodilla saat valittua VBA:lla avattavat tiedostot.

Dim Tiedosto1 As String, Tiedosto2 As String

With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "Excel työkirja", "*.xls", 1
    .Title = "Valitse 1. tiedosto"
    .Show
    Tiedosto1 = .SelectedItems(1)
End With
With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "Excel työkirja", "*.xls", 1
    .Title = "Valitse 2. tiedosto"
    .Show
    Tiedosto2 = .SelectedItems(1)
End With

MsgBox "Valitsit tiedostot: " & Tiedosto1 & " ja " & Tiedosto2

Työkirjat saat avattua seuraavasti:

Dim Työkirja1 As String, Työkirja2 As String
    Workbooks.Open Filename:=Tiedosto1, UpdateLinks:=0, ReadOnly:=1
    Työkirja1 = ActiveWorkbook.Name

    Workbooks.Open Filename:=Tiedosto2, UpdateLinks:=0, ReadOnly:=1
    Työkirja2 = ActiveWorkbook.Name

Vertailuja työkirjojen välillä voit tehdä koodissa viittaamalla työkirjoihin oheiseen tapaan:

If Workbooks(Työkirja1).Sheets(0).Range("a1").Value = Workbooks(Työkirja2).Sheets(0).Range("a1").Value Then
    'jotain...
End If

Etköhän näillä pääse alkuun...

Moikka taas OmenaJunnu!

Minua alkoi nyt vähän vaivaamaan tämä polkutieto-jutska, joten olisitko nyt niin ystävällinen ja selostaisit seikkaperäisesti: minkä tiedoston(jen) polun tallentamisesta muistiin nyt oikein on kysymys?

Moikka taas OmenaJunnu!

aavistin kyllä, mutta tässä hieman lisää 'salaisuuksia'
(& sitäpaitsi olit aivan oikeilla jäljillä...)

ThisWorkbook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  palautus

End Sub

module1:

'*** määritellään globaalit muuttujat
Global orginaaliPolku As String, rekisteriarvo As Boolean

Sub auto_open()

  '!!!tämä aliohjelma suoritetaan ilman erillistä
  'viittausta aina kun työkirja avataan

  'mikäli nyt sattuisi käymään niin, että alkuperäiset
  'tiedostopolkuasetukset säädellessä hukkuisivat niin
  'poistamalla rivien 'orginaaliPolku=... & 'palautus
  'edestä hipsu, tallentamalla työkirja, sulkemalla ja
  'avaamalla se uudelleen saadaan asetukset palautettua

  'orginaaliPolku = Environ("userprofile") & "\Omat tiedostot"
  'palautus

  'tallennetaan alkuperäinen oletushakemisto
  'globaaliksi määritettyyn muuttujaan
   orginaaliPolku = Application.DefaultFilePath

  'Jos työkirjan nimi on oikea niin...
  '(vaihda tilalle oman tiedostosi nimi)
  If ActiveWorkbook.Name = "polku.xls" Then

    'siirrytään aliohjelmaan:
    haePolku

  End If

End Sub

Sub haePolku()

  Dim asetus As String

  'tutkitaan rekisteristä mahdollinen tiedostopolku asetus
  asetus = GetSetting(Left(ActiveWorkbook.Name, _
  Len(ActiveWorkbook.Name) - 4) & "XLS", "xlAvain", "arvo")

  'jos asetus on rekisterissä...
  If Len(asetus) > 0 Then

  'asetetaan rekisteriarvon totuusarvo
  rekisteriarvo = True

  'aseteaan oletustiedostopolku rekisteröidyn arvon perusteella
  Application.DefaultFilePath = asetus

  If Left(asetus, 2) <> Left(orginaaliPolku, 2) Then
    ChDrive Left(asetus, 2)
  End If

  ChDir asetus

  'ja poistutaan aliohjelmasta
  Exit Sub

   'muutoin siirrytään...
  Else
    'aliohjelmaan:
    asetaPolku
  End If

End Sub

Sub asetaPolku()

  'viittaamalla tähän aliohjelmaan esim.
  'taulussa näkyvän napin Click_tapahtumassa
  'voidaan asetusta vaihtaa milloin huvittaa...

  Dim asetus As String

  'haetaan polku Excelin FileOpen dialogilla
  'jokin tiedosto pitää valita, muutoin
  'FileOpen dialogi palauttaa merkkijonona: "False"

  'annetaan pientä ohjeistusta...Tämä dialogi näytetään
  'automaattisesti aina kun työkirja avataan ensimmäisen
  'kerran uudessa ympäristössä = "KONE" tai aliohjelmaan
  'viitatessa, kun haluttaan muuttaa asetusta...
  msg& = MsgBox("HUOM! tällä toiminnolla ei avata tiedostoa! " & _
  "Ainoastaan levyasemasta\hakemistopolusta" & _
    vbCrLf & "palautuva tieto rekisteröidään " & _
      "tiedostojen oletushakemistopoluksi. " & _
      "Jokin tiedostonimi" & vbCrLf & "on kuitenkin " & _
      "valittava tarvittavan tiedon saamiseksi. " & _
      "Alkuperäinen oletustiedostopolku" & _
      vbCrLf & "palautetaan tämä työkirjan sulkemisen " & _
      "yhteydessä...", vbInformation, Application.Name)

  asetus = Application.GetOpenFilename("Excel työkirja (*.xls), *.xls")

  'Jos tiedostoa ei valittu poistutaan...
  If asetus = "False" Then
    Exit Sub
  End If

  'viritelmä toimi myös intrassa
  'mikäli yhteys näkyy levyasemana
  For i = Len(asetus) To 1 Step -1

    'poistetaan tiedostonimi polusta
    If Mid(asetus, i, 1) = "\" And i > 3 Then
      asetus = Left(asetus, i - 1): Exit For
    ElseIf Mid(asetus, i, 1) = "\" And i = 3 Then
      asetus = Left(asetus, i): Exit For
    End If

  Next i

  'tallennetaan tieto hakemistopolusta rekisteriin
  'Huom! tämän työkirjan tiedostonimen muutos
  'vaikuttaa nyt tallennettavan rekisteriarvon
  'saatavuuten, joten uuden avaimen rekisteröintiä
  'ehdotetaan automaattisesti, kun uudella nimellä
  'tallennettu tiedosto avataan ensimmäistä kertaa.
  Dim polku As String

  SaveSetting Left(ActiveWorkbook.Name, _
  Len(ActiveWorkbook.Name) - 4) & "XLS", _
  "xlAvain", "arvo", asetus

  'asetetaan oletus tiedostopolku
  Application.DefaultFilePath = asetus

  'ilmoitetaan muutoksen rekisteröinnistä
  MsgBox "Asetus viety rekisteriin", _
  vbInformation, Application.Name

  'asetetaan rekisteriarvon totuusarvo
  rekisteriarvo = True

End Sub


Sub poistaAsetus()
  'viittaamalla tähän aliohjelmaan voidaan
  'rekisteröinti poistaa milloin huvittaa

    'jos arvo on rekisterissä niin...
    If rekisteriarvo = True Then

    DeleteSetting (Left(ActiveWorkbook.Name, _
    Len(ActiveWorkbook.Name) - 4) & "XLS")

    'asetetaan rekisteriarvon totuusarvo
    rekisteriarvo = False

    'palautetaan orginaaliasetukset
    palauta

  End If

End Sub

Sub palautus()

  '***Jos oletustiedostopolku on eri, kuin globaaliin
  'muuttujaan varastoitu tieto alkuperäisasetuksesta niin...
  If Application.DefaultFilePath <> orginaaliPolku Then
    Application.DefaultFilePath = orginaaliPolku
    ChDrive Left(orginaaliPolku, 2)
    ChDir orginaaliPolku
    MsgBox "palautetaan alkuperäinen oletus tiedostopolku", vbInformation, Application.Name
  End If

End Sub

EDIT: there's a f****** bug; change all palauta to palautus
note: if you do change the orginal filename, the filename
in the line - If ActiveWorkbook.Name = "polku.xls"... - must be
changed manually...

Kiitos todella paljon neau33 ja Hycke!

Olen tehnyt tässä muita hommia välillä, että en ole ehtinyt tehdä "ohjelmaa" eteenpäin.
Lähinnä mietin tuossa sitä tiedosto polun tallennusta kun sain sen näytettyä käyttäjälle mutta en tallennettua muistipaikkaan.

Todella mukavaa, että täältä saa apua vaikka ei omat taidot ovat vasta kehittymässä.

OmenaJunnu kirjoitti:

Kiitos todella paljon neau33 ja Hycke!

Olen tehnyt tässä muita hommia välillä, että en ole ehtinyt tehdä "ohjelmaa" eteenpäin.
Lähinnä mietin tuossa sitä tiedosto polun tallennusta kun sain sen näytettyä käyttäjälle mutta en tallennettua muistipaikkaan.

Todella mukavaa, että täältä saa apua vaikka omat taidot ovat vasta kehittymässä.

Pystyykö omia viestejä muokkaamaan jotenkin

OmenaJunnu kirjoitti:

Pystyykö omia viestejä muokkaamaan jotenkin

Siitä "Muokkaa"-linkistä viestin päällä tunnin ajan viestin lähetyksen jälkeen.