kunde

Vapaa kuvaus

Isaan Rules WFF CCC If you walked away smiling-then for you the price was right Keep Exceling Suosikkibändit/artistit: Queen, Rammstein, genesis, Bruce Bringsteen, Kino, Mandref Mann Earth band Who Lempikirjat: ohjelmointi... Suosikkipalstat Suomi24 Keskusteluissa: EXCEL, Kivitalot, EPS En pidä: pakkanen ja loskakelit Ruoka & juoma: loimulohi ja valkkari Linkit: http://www.kundepuu.com, Khorat Koulutus: --- Ammatti: Tiede/teknologia Työskentelen: freelancer Ase tai siviilipalvelus: yliluutnantti Siviilisääty: Varattu Lapset: --- Hakusanat: Thaimaa, korat, Excel, VBA, ACAD, CNC, Polyurea, EPS, MgO elementti

Aloituksia

7

Kommenttia

1374

  • Uusimmat aloitukset
  • Suosituimmat aloitukset
  • Uusimmat kommentit
  1. etpähän maininnut alkujaan, että solussa useampi muotoilu...
    no nyt koodi tekee haluamasi

    Sub TekstiSiirto()
    Dim vika As Integer
    Dim a As Variant
    Dim Alku As Integer
    Dim Pituus As Integer
    On Error Resume Next
    Application.ScreenUpdating = False
    vika = Range("B65536").End(xlUp).Row

    For Each solu In Range("B1:B" & vika)
    a = Split(solu, " ") ' erottimena välilyönti
    Alku = 1
    For i = 1 To UBound(a) + 1
    Pituus = Len(a(i - 1))
    väri = solu.Characters(Start:=Alku, Length:=Pituus).Font.ColorIndex
    solu.Offset(0, i) = a(i - 1)
    solu.Offset(0, i).Characters(Start:=1).Font.ColorIndex = väri
    Alku = Alku + Pituus + 1
    Next
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    End Sub
  2. moduuliin...

    Sub TekstiSiirto()
    Dim vika As Integer
    Dim a As Variant
    On Error Resume Next
    Application.ScreenUpdating = False
    vika = Range("B65536").End(xlUp).Row
    For Each solu In Range("B1:B" & vika)
    a = Split(solu, " ") ' erottimena välilyönti
    For i = 1 To UBound(a) + 1
    solu.Copy
    solu.Offset(0, i + 1).PasteSpecial Paste:=xlPasteFormats
    solu.Offset(0, i + 1) = a(i - 1)
    Next
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    End Sub
  3. jos haluat estää muotoilemasta asetuksia esikatselussa niin lisää FALSE esikatselu komennon perään
    ActiveSheet.PrintPreview False

    Tulostusalueen valinnan poisto oli ihan Ok lisäys. ;-)
  4. tutustuppa Tiedot/lomake. Tekee just sen mitä kyselet.
  5. muuta Ok-painikkeen Default arvo arvoksi TRUE. Oletuksena on FALSE
    :-)
  6. määritellään tulostusalue, jolloin ei tulosteta muuta kuin se alue.Tietenkin pitää pitää huolta, että mahtuu yhdelle sivulle

    Sub EsikatsaTulosta()
    Dim Viimeinenrivi As Integer
    Application.ScreenUpdating = False
    Viimeinenrivi = Range("B65536").End(xlUp).Row

    ActiveSheet.PageSetup.PrintArea = "B2:K" & Viimeinenrivi
    ActiveSheet.PrintPreview
    Range("A1").Select
    Application.ScreenUpdating = True
    End Sub
  7. viimeinenrivi palauttaa lukuarvon eikä tekstiä
    muutin sen kanssa

    Sub EsikatsaTulosta()
    Dim Viimeinenrivi As Integer
    Application.ScreenUpdating = False
    Viimeinenrivi = Range("B65536").End(xlUp).Row
    Range(Cells(2, 2), Cells(Viimeinenrivi + 1, 11)).Select
    ActiveSheet.PrintPreview
    Range("A1").Select
    Application.ScreenUpdating = True

    End Sub
  8. Itse en ole toistaiseksi joutunut pahemmin turvautumaan VBA:han / makroihin. Mieluiten käytän yksinkertaisinta lähestymistapaa, eritoten jos muidenkin on tarkoitus käyttää taulukkoa... Keep it simple! :)

    kun teet taulukon, jossa tarkastalet soluihin syötettyjä arvoja ja varmistelet, että vain oikeat arvot on syötetty ja teet virheilmoitukset käyttäjälle. Ei meinaan ole enää mitään simppeliä tavallisilla excelin kaavoilla...
    ilmeiseti sun sovellutukset sen verran simppeleitä...
    no tää nyt vähän offtopicina tähän yksinkertaiseen juttuun
  9. kivahan se on kopioida kaavoja manuaalisesti ehkä tuhansiin riviin. Kumpi sitten helpompi/vaikeampi copy/paste moduuliin kerran vaiko kaavojen kopiointi....
  10. TAULUKON moduuliin...
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim vika As Integer
    Dim vika2 As Integer
    Dim Alue As Range
    Dim i As Integer
    On Error Resume Next
    vika = Range("M65536").End(xlUp).Row
    For i = 1 To vika
    If Range("C" & i) = Range("M" & i) Then
    Range("N" & i) = "Audi"
    End If
    If Range("G" & i) = Range("M" & i) Then
    Range("N" & i) = "Volvo"
    End If
    Next
    End Sub
  11. tällä nyt vaikka alkuun

    solu A10 teksti päiväys
    solu b 10 teksti summa

    maalaa solut A10 ja B10 ja kaavaruutuun kirjoitat tietokanta ja ENTER. Nyt pitäisi olla nimetty alue tietokanta
    samoin tee esim.

    solu H1 teksti lakun pvm
    solu I1 teksti laskun summa

    maalaa solut H2 ja I2 ja kaavaruutuun kirjoitat syöttöalue ja ENTER. Nyt pitäisi olla nimetty alue syöttöalue.

    Jos ei onnistu noin niin tee lisäämällä nimi valikon kautta

    lisää nappi yläriville (ennen riviä 10) ja liitä siihen makro UusiLasku

    moduuliin...

    Option Explicit
    Sub UusiLasku()
    Dim Rivi As Long
    On Error GoTo virhe
    If Range("Syöttö").Cells(1, 1) = "" Or _
    Not OnkoPäiväys(Range("Syöttö").Cells(1, 1)) Then
    Range("Syöttö").Cells(1, 1).Select
    MsgBox "Anna päiväys! esim 12.2.2006 tai 12/6/2006", vbInformation
    Exit Sub
    End If
    If Range("Syöttö").Cells(1, 2) = "" Or _
    Not IsNumeric(Range("Syöttö").Cells(1, 2)) Then
    Range("Syöttö").Cells(1, 2).Select
    MsgBox "Anna summa!", vbInformation
    Exit Sub
    End If
    With Range("Tietokanta") ' itse määritelty alue
    Rivi = .Rows.Count + 1 'lisätään tietokantaan rivi
    Range("Syöttö").Copy Destination:=.Cells(Rivi, 1) ' kopioidaan tiedot
    .Resize(Rivi).Name = "Tietokanta" ' päivitetään tietokanta lisäyksen jälkeen
    End With
    Range("Tietokanta").Offset(Range("Tietokanta").Rows.Count) = ""
    Range("A10").Offset(Range("Tietokanta").Rows.Count + 2, 0) = Range("Syöttö").Cells(1, 1)
    Range("B10").Offset(Range("Tietokanta").Rows.Count + 2, 0).FormulaLocal = "=SUMMA(B10:B" & Range("Tietokanta").Rows(2).End(xlDown).Row & ")"
    Range("Syöttö") = "" 'tyhjennetään syöttöalue
    virhe:
    End Sub

    Function OnkoPäiväys(Pvm As String) As Boolean
    Dim Päiväys As Date
    On Error GoTo virhe
    Päiväys = DateValue(Range("Syöttö").Cells(1, 1))
    OnkoPäiväys = True
    Exit Function
    virhe:
    OnkoPäiväys = False
    End Function

    nyt laskee automaattisesti summan yhden tyhjän rivin päähän viimeisestä laskusta( koska helpompi käsitellä asioita näin)
    Voit aivan vapaasti poistaa rivejä välistä tai lopusta ja silti ohjelma toimii oikein!
    Arvot syötetään H2 ja I2 ja sen jälkeen klikkaat nappia.
    Lisäsin vielä tarkistukset tyhjille arvoille sekä tarkistukset, että on päiväys sekä luku
    :-)
  12. kuten arvelitkin ei Excelillä voi hakea toisesta solusta pelkkiä kaavoja- ainostaan kaavojen tuloksia.
    VBA:lla asia on kuitenkin todella helppo tehdä. Pari tekstifunktiota ja tulosten yhdistäminen...

    Tein nyt oman käyttäjän makron - liitä se moduuliin. Siihen soluun mihin haluat kaavan kopioituvan kirjoitat

    =TeeKaava(E21;25)
    missä Solu=E21 ja Siirtymä=25 (esimerkkisi mukaan), eli Solu on se solu, josta kaava kopioidaan(E21) ja Siirtymä(25) on siirtymä uudesta kaavasolusta. Kaava toimii vaikka vaihdat solunosoitetta esim.
    Ruokapäiväkirja!D27--->Päiväkirja!D27

    :-)

    moduuliin...

    Function TeeKaava(Solu As Range, Siirtymä As Integer) As String
    Dim teksti As String
    Dim eka As Integer
    Dim toka As Integer
    Dim osoite As String
    Dim osoite1 As String
    Dim osoite2 As String
    Dim siirto As Integer
    On Error Resume Next
    Application.Volatile
    teksti = Solu.FormulaLocal

    eka = InStr(1, teksti, "!")
    toka = InStr(1, teksti, ";")
    'alkuperäinen offsetsolu
    osoite1 = Mid(teksti, eka + 1, toka - eka - 1)

    eka = toka + 1
    toka = InStr(eka, teksti, ";")
    siirto = Mid(teksti, eka, toka - eka)
    'uusi offsetsolu
    osoite = Range(osoite1).Offset(siirto, 0).Address

    eka = InStr(1, teksti, "(")
    toka = InStr(1, teksti, "!")
    'alkuperäinen offsetsolu
    osoite2 = Mid(teksti, eka + 1, toka - eka)

    TeeKaava = "=SIIRTYMÄ(" & osoite2 & osoite & ";" & Siirtymä & ";0;1;1)"
    End Function
  13. tee kirjainmerkki Alku dokumentin alkuun ja sivun loppuihin lisäät Gotobutton kentän ja siihen kirjainmerkiksi Alku ja näytä tekstiksi vaikka Alkuun. Tuplaklikkaamalla siirtyy sitten dokumentin alkuun.
  14. mutta kysymyksesi liian yleinen.
    Haetaanko samasta työkirjasta, toisesta avoimesta vai suljetusta työkirjasta.
    Mistä hakutiedot saadaan?
    siirretäänkö koko rivin tiedot vai osa tietoja jne...

    asiasta keskusteltu allaolevissa linkeissä

    http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000018689094

    http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000017181332
    15. 69 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt