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. ihan samanlailla dokkarissa harmaana näkyy oli se sitten valkoista tai punaista tekstiä...

    yksi keino on luoda tosiaan oma digitaalinen allekirjoitus
    C:\Program Files\Microsoft Office\Office tuolta löytyy SELFSERT kirjoita siihen nimesi ja klikkaa OK.
    Avaa dokkarisi ja ALT+F11 ja pääset VBA editoriin ja sieltä TOOLS/DIGITAL SIGNATURE ja lisää nimesi sinne.
    Edelleen TOOLS/PROJECT PROPERTIES/PROTECTION ja laita tarpeeksi pitkä salasana ja käytä erikoismerkkejä ja OK.

    INSERT/MODULE ja kirjoita moduuliin vaikka tommonen koodin pätkä

    Sub Koe()
    End Sub

    Tallena dokkari ja sulje se. Avaa se uudelleen, nyt pitäisi aueta lomake jossa kysytään oletko luotettava jne... ruksi ruutuun ja seuraavilla kerroilla ei enää kyselekkään.
    Nyt sulla on ainakin tavalliselle käyttäjältä purtavaa ihan tarpeeksi...
    Niin taitaahan tuo kysellä joka koneella ekalla kertaa tota luotettavuutta...
  2. Toi on todella käyttökelpoinen ja lisättynä Offset ja Resize niin siinäpä jo pelimerkkejä jo piisalle asti
    vika=Range("A1").End(xlDown).Row ja Range("A1:A" & vika)
    hakee siis A1 alaspäin yhtenäisen alueen viimeisen rivin(ei saa olla tyhjiä välissä)

    vika=Range("A65536").End(xlUp).Row ja Range("A1:A" & vika)
    hakee A65536 eli viimeisesta A sarakkeen solusta ylöspäin ja palauttaa A1 & A vika alueen ja näin ollen tolla alueella voi olla tyhjiäkin soluja...

    samat toiminnat sitten vasemmalle ja oikealle

    vika = Range("A1").End(xlDown).Row
    Range("A1:A" & vika).Offset(0, 1).Select

    valitsee sarakkeesta B A sarakkeessa olevan yhtenäisen A1 alkavan alueen kokoisen alueen

    vika = Range("A1").End(xlDown).Row
    Range("A1:A" & vika).Offset(0, 1).Resize(vika-3, 5).Select

    nyt valitsee 3 riviä vähemmän ja laajentaa sarakkeet 5 ja alkaa B sarakkeesta

    joten valinnan saa minne vaan helposti ja sitten kun lisää vielä SpecialCells niin kaikkea mukavaa voidaankin jo tehdä näillä
    Koska kyseessä Range objekti, sillä on paljon ominaisuuksia ja se onkin yksi käytetyin objekti omissa projekteissani

    Keep Exceling
  3. ekalle riville otsikot
    A1=projektin nimi
    B1=aloitusaika
    C1=kokonaisaika
    D1=käynnissä
    sarakkeen E voi piilottaa
    lisäät pari nappia oletuksineen ja liität niihin koodit

    Private Sub CommandButton1_Click()
    Kaynnista
    End Sub

    Private Sub CommandButton2_Click()
    Lopeta
    End Sub

    ja moduuliin...

    Public Milloin As Double
    Dim Laskuri As Date
    Dim alku As Boolean
    Dim vika As Integer
    Sub Kaynnista()
    alku = False
    Aloita
    End Sub
    Sub Aloita()
    If alku = True Then Exit Sub
    vika = Range("A1").End(xlDown).Row
    For Each Solu In Range("A1:A" & vika)
    If Not Solu = "" And Range("D" & Solu.Row) = 1 Then
    If Range("B" & Solu.Row) = "" Then
    Range("B" & Solu.Row) = Now
    End If
    Laskuri = Now - Range("B" & Solu.Row) + Range("E" & Solu.Row)
    Range("C" & Solu.Row).Value = Format(Laskuri, "h:mm:ss")
    End If
    If Not Solu = "" And Range("D" & Solu.Row) = 0 Then
    If Not Range("B" & Solu.Row) = "" Then

    Range("E" & Solu.Row) = Format(Range("C" & Solu.Row), "h:mm:ss")
    Range("B" & Solu.Row) = ""
    End If
    End If
    Milloin = Now + TimeSerial(0, 0, 1)
    Next
    Application.OnTime Milloin, "Aloita", , True
    End Sub

    Sub Lopeta()
    On Error Resume Next
    alku = True
    Application.OnTime Milloin, "Aloita", , False
    Range("D2:D" & vika) = 0
    Range("B2:B" & vika) = ""
    End Sub

    Toimii seuraavasti:
    klikkaa nappia 1, joka käynnistää luuppimakron
    kirjoita projektin nimi sarakkeeseen A
    soluun D kirjoita 1(1=käynnissä-0 ei käynnissä)
    soluun B ilmestyy aloitusaika ja soluun C kokonaisaika

    keskeytät projektin kirjoittamalla D soluun 0
    B solu tyhjennetään ja kokonaisaika säilyy
    starttaa uudelleen projekti kirjoittamalla soluun D 1

    makron saat pois toimimasta klikkaamalla nappia 2

    tostahan nyt sitten saa ideaa miten jatkaa
    tietenkin voisi tehdä events jutuillakin, mutta sitä vähän vaikea jalostaa makronauhottajien.
  4. :-)
  5. mutta liian monimutkainen. Muistaakseni olet joskut vastannut BeforePrint juttuun ja kertonutkin siellä Cancel muuttujasta...
    Unohtuiko?

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
    'tähän fontin värin muutos tai alueen luku muistiin
    'printtaus
    'väri takaisin alkuperäiseksi ja tietojen palautus
    cancel=true
    End Sub

    elikä tehdään omat jutut ennen printtausta ja printataan itse ja sitten peruutetaan varsinainen tulostuskomento

    näppärää eikös vaan...
  6. semmoiseksi projektin hallinnaksi...
    katsotaan jaksanko huomenna duunailla
  7. Todennäköisesti sulla ei ole aika muuttujaa määritelty eli aika on jäljessä ja ei voi silloin lopettaa "ajallaan"
  8. ihan perusjuttuna
    tee nappi ja muuta Captioniksi "Aloita" ilman lainausmerkkejä ja liitä siihen koodi

    Private Sub CommandButton1_Click()
    If Me.CommandButton1.Caption = "Aloita" Then
    testi = False
    Aloita
    Me.CommandButton1.Caption = "Lopeta"
    Else
    testi = True
    Lopeta
    Me.CommandButton1.Caption = "Aloita"
    End If
    Range("C1").Select'tämä siksi ettei nappula jää aktiiviseksi
    End Sub

    ja moduuliin...

    Public Aika As Date
    Public testi As Boolean
    Sub Aloita()
    On Error Resume Next
    If Not testi Then
    Range("A1") = Format(Now, "hh:mm:ss")
    Range("C1") = ""
    testi = True
    End If
    Aika = Now + TimeValue("00:00:01")
    Application.OnTime Aika, "Aloita"
    Range("B1") = Format(Now, "hh:mm:ss")

    End Sub

    Sub Lopeta()
    On Error Resume Next
    Application.OnTime Aika, "Aloita", , False
    testi = False
    Range("C1") = Format(Range("B1") - Range("A1"), "hh:mm:ss")
    End Sub

    Nyt kun klikkaat nappia siinä lukee aloita ja se muuttuu lopeta. Aluksi kirjoittaa aloitus ajan A1 ja kun lopetat niin lopetusajan B1 ja kokonaisajan C1

    Keep Exceling
  9. tossapa sulle makro, jolla kikkailemalla voi sitten tehdä mitä vaan, koska se palauttaa Rangen...

    nyt hakee 1000 sarakkeista A:D ja kopioi rivit Taul2 sarakkeeseen A ensimmäistä tyhjästä solusta alkaen
    Union funktiota joutuu käyttään sen takia, koska luku voi löytyä useammasta sarakkeesta ja tällöin alueet leikkaavat ja antaa virheilmoituksen- tolla siis korjataan tuo...

    moduuliin...
    Function LaajennettuHaku(Hakuehto As Variant, _
    Hakualue As Range, _
    Optional Mitä As Variant, _
    Optional Miten As Variant, _
    Optional Kokosolu As Boolean) As Range

    Dim solu As Range
    Dim Eka As String
    If IsMissing(Mitä) Then Mitä = xlValues
    If IsMissing(Miten) Then Miten = xlPart
    If IsMissing(Kokosolu) Then Kokosolu = False

    With Hakualue
    Set solu = .Find( _
    What:=Hakuehto, _
    LookIn:=Mitä, _
    LookAt:=Miten, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=Kokosolu, _
    SearchFormat:=False)
    If Not solu Is Nothing Then
    Set LaajennettuHaku = solu
    Eka = solu.Address
    Do
    Set LaajennettuHaku = Union(LaajennettuHaku, solu)
    Set solu = .FindNext(solu)
    Loop While Not solu Is Nothing And solu.Address Eka
    End If
    End With

    End Function

    Sub Testi()
    On Error GoTo virhe:
    Dim löydetty As Range
    Set löydetty = LaajennettuHaku(1000, Columns("A:D"), xlValues, xlPart, False).EntireRow
    Union(löydetty, löydetty).Copy Range("Taul2!A65536").End(xlUp).Offset(1, 0).EntireRow
    Exit Sub
    virhe:
    MsgBox "Hakuehdollasi ei löytynyt yhtään tietuetta!"
    End Sub

    Keep Excelling
  10. tee nappula jasiihenliität makron, joka ajaa esim. Auto_Close makron.Tapojahan on monia

    tollahan se palautetaan normaaliksi

    Sub Auto_Close()
    Application.OnKey "{TAB}"
    End Sub
    Auto_CLose makron
  11. kysyjä halusi tabulaattorilla alaspäin eikä enterillä
    moduuliin ja kun olet tallentanut(tai ajanut Auto_Open makron) niin tabulaattorilla siirrytäänkin alaspäin

    Sub Auto_Close()
    Application.OnKey "{TAB}"
    End Sub

    Sub Auto_Open()
    Application.OnKey "{TAB}", "Alas"
    End Sub
    Sub Alas()
    On Error Resume Next
    ActiveCell.Offset(1, 0).Select ' menee 1 solun alas
    ActiveCell.Offset(-1, 0).Select ' menee 1 solun ylös jne...
    End Sub


    M.O.T
  12. Viime vuonna vastasin tommoseen kyseleen ja tein VBA makron- en jaksa nyt alkaa kaivelemaan
  13. Koska se on kuvalinkki myös muutokset soluissa näkyvät kuvassa ja sitä voi siirrellä haluamaasi paikkaan
  14. 1. Maalaa solut Taul1 mitkä haluat kopioitavan muille sivuille.
    2. Kopioi alue
    3. Valitse Taul2(tai kaikki taulukot mihin haluat kopioida) ja solu A1
    3. SHIFT pohjassa Muokkaa/Liitä kuvalinkki
    ja se on siinä :-)

    Nyt kaikki tekemäsi muutokset Taulukko 1 otsikkoriveillä näkyvät myös muissa taulukoissa. Ja voit vapaasti muotoilla taulukkoasi ilman, että muotoilut muuttavat kuvaasi tai kääntäen voit vapaasti muotoilla Taulukko1 muotoiluja ilman, että muiden taulukoiden muotoilut muuttuvat
    @Kunde
    The Simple The Best
    Keep Exceling
  15. jos tiedot A1-> eteenpäin. Omassa funktiossani en ollut ottanut huomioon, jos tiedot muualla kuin A1 alkaen(lämpö herpaannuttaa keskittymisen välillä). Alla korjattu versio
    KIITOS tarkkaivaisuudestasi utelias!

    Public Function OmaKeskihajonta(Nimi As String, Hakualue As String)
    Dim Alue As Range
    Set Alue = Range(Hakualue).Range("A1").Offset(0, -1)
    For Each solu In Range(Hakualue)
    If solu = Nimi Then
    Set Alue = Application.Union(Alue, solu.Offset(0, -1))
    End If
    Next
    OmaKeskihajonta = Application.WorksheetFunction.StDev(Alue)
    Alue.Select
    End Function
  16. jos kaavan nolla tulos näytetään tyhjänä eikä nollana, saa tuon säädettyä taulukon asetuksista, näytetäänkö tulos nollana vai tyhjänä
    Mistä löytyy tuo säätö???

    eli jos kaavan tulos on "" miten sen saat tolla

    Tools -> Options -> Wiev, ruksi kohtaan Zero values.
    näyttään 0 arvoa???

    ton minä haluaisin tietää!
  17. oletuksena nyt tiedot A1:B100 soluissa
    soluun johon haluat tuloksen laita kaava
    =OmaKeskihajonta("teuvo";"B1:B100")

    ja moduuliin...

    Public Function OmaKeskihajonta(Nimi As String, Hakualue As String)
    Dim Alue As Range
    Set Alue = Range("A1")
    For Each solu In Range(Hakualue)
    If solu = Nimi Then
    Set Alue = Application.Union(Alue, solu.Offset(0, -1))
    End If
    Next
    OmaKeskihajonta = Application.WorksheetFunction.StDev(Alue)
    End Function
  18. moduuliin...
    Sub Lisaa()
    Range("A1").Select
    For i = 2 To 1000 Step 2
    ActiveCell = i
    ActiveCell.Offset(1, 0) = i
    ActiveCell.Offset(2, 0).Select
    Next
    End Sub
  19. Sen voi tehdä ilman koodia seuraavasti. Valitse alue ja Edit/Goto/Special/ ja sieltä Blanks. Kirjoita sitten 0 ja CTRL= enter jolloin kirjoittaa kaikkiin alueen tyhjiin soluihin 0. Jos kaavalla olet tehnyt nakymän tyhjäksi sitä ei voi näyttää 0 arvona ilman, että menetät kaavasi.
    VBA:lla vastaava

    moduuliin

    Sub LisaaNollat()
    Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks) = 0
    End Sub
  20. Ruksi kohtaan nolla-arvot. Ja vot, kyll näkyy nollat!
    ei toi mitään nollia kirjoita tyhjiin soluihin niinkuin kysyjä halusi!
    21. 66 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt