Keskustelu: Ohjelmointikysymykset: VBA-koodin suorittaminen vain kerran

Minulla on Excel-taulukko, jossa on hinnat sentteinä. Olen tehnyt käyttäjälomakkeen, jossa on painikkeita, jotka tekevät erilaisia asioita. Minulla on myös yhden painikkeen alla koodi, joka jakaa nuo hinnat sadalla, jotta saan ne euroiksi. Nyt minun ongelmani on se, että en osaa tehdä sitä koodia niin, että se jakaisi nuo luvut vain kerran. Eli jos käyttäjä painaa uudelleen tuota jaa sadalla-painiketta, niin koodin pitäisi osata sanoa, että luvut on jo kerran jaettu sadalla. Olen käyttänyt Do while Loop- rakennetta tuossa koodissa, joka jakaa luvut sadalla. Olen kokeillut monenlaisia juttuja esim. exit do, mutta en saa sitä toimimaan. Te minua paljon viisaammat, osaatte varmasti kertoa miten tämä onnistuu?

Yksi vaihtoehto olisi, että laittaisit koodin poistamaan painikkeen kun se ajetaan.

Kiitos vastauksestasi Grez! Tuo on muuten hyvä idea, mutta se ei tässä tapauksessa toimi, koska tuota käyttäjälomaketta käytetään aina uudelleen uuden Excel-taulukon kanssa ja tarvitaan siis jakaa ne luvut sadalla aina yhden kerran per taulukko.

Mitä jos uhraat yhden solun tiedolle, että onko taulukko jo jaettu sadalla? Voit ennen jakoyritystä lukea solun tiedon. Vaihtoehtoisesti voit uhrata toiselta sivulta vaikka kokonaisen taulukon, missä on jokaiselle taulukon solulle erikseen tiedot mitä sille on jo tehty.

VBA:ta ja Exceliä paremmin tuntevat osannevat antaa parempia neuvoja, mutta tuon ainakin pitäisi toimia.

Pystytkö laittamaan taulukolle tiedon, onko kyse senteistä vai euroista? Eli jos vaikka sarakkeen otsikkona on "hinta" tai "hinta sentteinä" niin muunnoksen yhteydessä muutat siihen "hinta euroina". Sitten kun nappia painetaan, se tarkistaisi tuon ja jos siellä olisi valmiiksi "hinta euroina" niin se ilmoittaisi että "hinnat on jo euroissa" ja poistuisi (exit sub)

Edit: Torgo tuossa näköjään laittoikin jo väliin

Heippa Mamma!

testaa oheisen viritelmän toimivuutta...

'module1 (lisää VBA-Projektiin)

'Jos Excel-työkirjan VBA-Projektiin on liitetty globaali moduuli,
'johon on luotu aliohjelma nimeltä: auto_open niin ko. aloiohjelma
'suoritetaan automaattisesti aina, kun ko. Excel työkirja avataan
'edellyttäen, että automaattinen makrojen suorittaminen on sallittu
'Excelin asetuksissa.
Sub auto_open()

   'Jos työkirjan laskentataulun: Taul1
   'viimeisen solun arvo on yhtäkuin
   'tyhjä merkkijono niin...
   If Taul1.Cells(Taul1.Rows.Count _
   , Taul1.Columns.Count).value = "" Then
   'aseteaan ko. solun arvoksi: False
   '(näkyy suomenkielisessä versiossa arvona: EPÄTOSI)
   Taul1.Cells(Taul1.Rows.Count _
   , Taul1.Columns.Count).value = False
   End If

End Sub

' UserForm1
Private Sub CommandButton1_Click()

   'välitetään funktiolle: ToEuros parametrinä
   'työkirjan taulun: Taul1, ensimmäisen solun
   'arvo ja asetetaan funkition palauttama arvo
   'variant muuttujan: ret arvoksi
   ret = ToEuros(Taul1.Cells(1, 1).value)

   'jos muuttujan ret arvo on eri, kuin
   'työkirjan taulun: Taul1, ensimmäisen solun
   'arvo niin astetaan ko. solun arvoksi
   'muttujan: ret arvo
   If ret <> Cells(1, 1).value Then
      Cells(1, 1).value = ret 'esim.
   End If

End Sub

Private Function ToEuros(value As Variant)

   If Taul1.Cells(Taul1.Rows.Count, _
   Taul1.Columns.Count).value = True Then
      'Jos työkijan taulun: Taul1 viimeisen
      'solun arvo on True (TOSI) niin asetetaan
      'funktion arvoksi funktiolle välitetyn
      'parametrin arvo ja poistutaan funktiosta
      '(mikään ei muutu)
      ToEuros = value: Exit Function
   Else
      Muutoin asetetaan tyokirjan taulun: Taul1
      viimeisen solun arvoksi: True (TOSI)
      Taul1.Cells(Taul1.Rows.Count, _
      Taul1.Columns.Count).value = True
   End If

   'Asetetaan funktion palautusarvoksi funktiolle
   'välitetyn parametrin arvo jaettuna sadalla
   ToEuros = value / 100

End Function

Kiitos kovasti Nea lähettämästäsi koodista, mutta olen aika aloittelija näissä koodiasioissa, enkä saanut koodiasi toimimaan. Voisitko laittaa kommentteja, mitä missäkin koodin vaiheessa tehdään, se voisi auttaa minua hahmottamaan asian.

Eikö olisi helpompaa ja yksinkertaisempaa tehdä senttien viereen sarake, jossa luku esiintyy euroina?

Heippa taas mamma!

voisit vielä testata seuraavanlaista viritelmää:
avaa uusi Excel työkirja, poista laskentatulukko: Taul3
nimeä laskentataulukko: Taul2 nimellä data ja aktivoi ko. taulu
valitse kaikki solut (siniseksi) klikkaamalla tyhjää aluetta
ennen sarakketta: A. valitse Muotoile -> Rivi ->Piilota
valitse jälleen Muotoile -> Sarake -> Piilota.
suojaa sitten taulukko (data) valitsemalla:
Työkalut -> Suojaus ->Suojaa taulukko ja anna salasanaksi: salasana
valitse jälleen: Työkalut -> Suojaus -> Suojaa työkirja
ruksaa vain: rakenne ja aseta taas salasanaksi: salasana
tallenna työkirja valitsemallasi nimellä.
Valitse: Työkalut -> Makro -> Visual Basic Editor,
lisää VBA-Projektiin lomake (UserForm1) ja lomakkeelle
2 komentopainiketta (CommandButton1 & CommandButton1)
Kasoisklikkaa jompaakumppaa komentopainiketta ja korvaa
kaikki näkyvissä oleva koodi alla olevalla koodilla (UserForm1)

'UserForm1
Private Sub CommandButton1_Click()

   Application.ScreenUpdating = False
   Sheets("data").Unprotect Password:=salasana

   Dim solu, osoite

   For Each solu In Selection

     osoite = Replace(solu.Address, "$", "")
     If Sheets("data").Range(osoite).Value = "" _
     And solu.Value <> "" Then
       Sheets("data").Range(osoite).Value = solu.Value
       solu.Value = solu.Value / 100
     End If

   Next


   Sheets("data").Protect Password:=salasana, _
   DrawingObjects:=True, Contents:=True, Scenarios:=True

   Cells(1, 1).Select
   Application.ScreenUpdating = True

End Sub

Private Sub CommandButton2_Click()

   Application.ScreenUpdating = False
   Sheets("data").Unprotect Password:=salasana

   Dim solu, osoite

   For Each solu In Selection

     osoite = Replace(solu.Address, "$", "")
     If Sheets("data").Range(osoite).Value <> "" Then
       solu.Value = Sheets("data").Range(osoite).Value
       Sheets("data").Range(osoite).Value = ""
     End If

   Next

   Sheets("data").Protect Password:=salasana, _
   DrawingObjects:=True, Contents:=True, Scenarios:=True

   Cells(1, 1).Select
   Application.ScreenUpdating = True

End Sub

Laajenna Project-ikkunassa projektisi (kansio) Microsoft Excel Objects
ja kaksoisklikkaa: ThisWorkBook kuvaketta, valitse vasemmanpuoleisesta
alasvetovalikosta: WorkBook ja kopioi alla oleva koodi koodi-ikkunaa.

'ThisWorkbook
Private Sub Workbook_SheetBeforeRightClick( _
ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   If Not UserForm1.Visible Then
      UserForm1.CommandButton1.Caption = "Euroiksi"
      UserForm1.CommandButton2.Caption = "Palauta"
      UserForm1.Show False
      SendKeys ("{ESC}")
   End If
End Sub

Testaa viritelmää kirjoittamalla esim. joillekkin sarakkeen A riveille lukuarvoja, valisemalla ko. solualue hiirellä, klikkaamalla hiiren kakkosnäppäintä valitsemasi solualueen sisälla ja sen jälkeen
klikkaamalla lomakkeen: Euroiksi -komentopainiketta.
Valise sitten sama solualue uudelleen ja klikkaa: Palauta -komentopainiketta.

Mikäli on ongelmia niin voit ladata täältä valmiin Excel (2003)/VBA-projektin ja tutkia viritelmää...

Kiitos kovasti Nea koodistasi! Hyvin toimii....