kunde

kunde profiilikuva
Joulu 2024
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

Liittynyt 20v sitten
7 aloitusta · 1377 kommenttia
Uusimmat aloituksetSuosituimmat aloituksetUusimmat kommentit
1. valitse sarake A
2. Muokkaa/Siirry/Asetukset/Tyhjät valintanappi aktiiviseksi ja OK
3. kaavariville kirjoita = ja klikkaa ensimmäisen tyhjän solun yläpuolista solua tai kirjoita se.
Esi jos eka tyhjä solu esim A6 niin siihen kaavariville =A5 ja kuittaat kaavan CTRL+ENTER eikä pelkästään enterillä!
Keep Excelling ;-)
http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000023268960

ja räätälöi sopivaksi hakualue nyt A sarake ja mistä palautetaan tiedot- offset on 0 pohjainen
tolla voit sitten hakea vasemmallekin(olen senkin joskus tänne postannut)eli nyt B sarakkeesta Offset(0, 1)
muutettu hakukoodi ja originaali funktio toimii edelleen...

Sub Testi()
On Error GoTo virhe:
Dim loydetty As Range
Set loydetty = LaajennettuHaku("mikko", Columns("A:A"), xlValues, xlPart, False).Offset(0, 1)
loydetty.Select
Union(loydetty, loydetty).Copy Range("Taul2!A65536").End(xlUp).Offset(1, 0)
Exit Sub
virhe:
MsgBox "Hakuehdollasi ei laytynyt yhtaan tietuetta!"
End Sub
näyttäisi mun väsäämältä koodilta...

nyt rivit 3:100 ja 6.luvun jälkeen pilkku ja 7 solussa 6 desimaalia...
en ehkä ymmärtänyt kysymystäsi oikein, mutta kuitenkin tossa koodi

Sub JaaLuku()
Dim i As Integer
Dim a As Integer
Range("B3:H100").NumberFormat = "@"
For Each solu In Range("A3:A100")
If Not solu = "" Then
a = 1
For i = 0 To 6
j = Array(1, 14, 8, 20, 6, 4, 6)(i)
If i = 5 Then
Cells(solu.Row, 2 + i) = Mid(solu, a, j) & ","
Else
Cells(solu.Row, 2 + i) = Mid(solu, a, j)
End If

a = a + j
Next
End If
Next

End Sub
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...
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
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.
:-)
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...
semmoiseksi projektin hallinnaksi...
katsotaan jaksanko huomenna duunailla
Todennäköisesti sulla ei ole aika muuttujaa määritelty eli aika on jäljessä ja ei voi silloin lopettaa "ajallaan"
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
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
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
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
Viime vuonna vastasin tommoseen kyseleen ja tein VBA makron- en jaksa nyt alkaa kaivelemaan
Koska se on kuvalinkki myös muutokset soluissa näkyvät kuvassa ja sitä voi siirrellä haluamaasi paikkaan
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
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
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ää!
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
66 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt