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
ei oo aikaa enempää kun reissua pukkaa...
poista kaavat N sarakkeesta ja lisää se koodissa oamakaavasi kohtaan...

jos ei onnaa niin viikon päästä palailen asiaan

väri on 15 =harmaa, muuta oikeaksi

taulukon moduuliin...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Offset(0, 12).Interior.ColorIndex = 15 Then
Target.Offset(0, 12) = ""
Else
Target.Offset(0, 12).Formula = "omakaavasi tähän"
End If
End If
End Sub

Keep EXCELing
@Kunde
haet siis solulla B59 arvoa toisesta taulukosta ja olet varmaankin kopioinut kaavaa alaspäin jolloin seuraavaan soluun haetaan arvoa solusta B60 jne...

tokassa kaavassa yrität sitten "funktioräpellyksestäsi" päätellen laskea solun N5 värin mukaan joko summaa tai solun N5 väristen lukumäärää soluista N4:N50 riippuen funktion kutsusta?

päin persettähän toi on kokonaan...
funktio ei palauta mitään

jos siis haluat laskea tietyltä alueelta tietynväriset arvot niin paras tehdä oma makro ja käyttää sitä ja samalla tyhjentää tietynväristen solujen arvot.
Mitenkäs noi värit soluun määritellään?

kahotaan saatko selkokielistä kyssäri aikaan...
periaaatteessa näin, mutta tietämättä miten suljet normaalisti, mutta helppo fiksata ...

ThisWorkbook moduuliin...

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Range("P2") = Now()
End Sub

Keep EXCELing
@Kunde
uteliaisuuttani kyselen voisitko lähettää mulle esimerkin tosta mailiini (versio Excel 2003) [email protected].

alkutilanne siis tää

https://skydrive.live.com/?cid=5cde060cd65c2e75&sc=photos&id=5CDE060CD65C2E75!189

ja tommonen siitä pitäs tulla

https://skydrive.live.com/P.mvc#!/view.aspx/Excel^_ongelma/Taulukko.xlsm?cid=5cde060cd65c2e75&sc=photos
=AVERAGE(OFFSET($D$1;0;0;COUNT($D:$D)))
=KESKIARVO(SIIRTYMÄ($D$1;0;0;LASKE($D:$D)))
piece of the cake...
joku aikaa sitten vastasin vastaavantapaiseen kyssäriin, jossa korvattiin joku sana toisella sanalla kaikkiin tiesotoihin kansiossa. Sitä rukkaa hieman .
löyinkin sen hetimiten, joten tossapa korjattuna nyt ISO standardin mukaiseksi...

Option Explicit

Sub Teetaulukko()
Dim vika As Long
Dim solu As Range
Dim viikko As Long
With Worksheets("Koonti")
.Activate
.Cells = ""
.Range("B1") = "viikko:"
.Range("B2") = "klo"
.Range("C1").Formula = "1"
LisääSarjat Range("C1"), 1, 52
LisääSarjat2 Range("A3")
End With
Worksheets("Taul1").Activate
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A3:A" & vika)
viikko = ViikkoISO(CDate(solu))
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") + 1, viikko + 2) = solu.Offset(0, 1)
Next
Worksheets("Koonti").Cells.EntireColumn.AutoFit
End Sub

Sub LisääSarjat(solu As Range, Aloitus As Long, Määrä As Long)
With Worksheets("Koonti")
solu.Formula = Aloitus
solu.AutoFill Destination:=Range(solu.Address & ":" & solu.Offset(0, Määrä).Address), Type:=xlFillSeries
End With
End Sub

Sub LisääSarjat2(solu As Range)
Dim i As Long
With Worksheets("Koonti")
solu.Select
For i = 1 To 7
ActiveCell = UCase(WeekdayName(i))
ActiveCell.Offset(0, 1).Formula = "0"
ActiveCell.Offset(0, 1).AutoFill Destination:=Range(ActiveCell.Offset(0, 1).Address & ":" & ActiveCell.Offset(23, 1).Address), Type:=xlFillSeries
ActiveWorkbook.Names.Add Name:=ActiveCell, RefersTo:=Range(ActiveCell.Address & ":" & ActiveCell.Offset(23, 54).Address)
ActiveCell.Offset(26, 0).Select
Next
End With
End Sub

Public Function ViikkoISO(Päiväys As Date) As Long
Dim D As Date
D = DateSerial(Year(Päiväys - Weekday(Päiväys - 1) + 4), 1, 3)
ViikkoISO = Int((Päiväys - D + Weekday(D) + 5) / 7)
End Function

Keep EXCELing
@Kunde
niinpä niin.
Excelhän laskee viikot väärin-eli ei ISO standardin mukaisesti .... ;-)
Pitänee aamulla fiksata sulle ISO standardin mukainen koodi. En jaksa nyt ettiä sitä koneeltani, mutta piece of cake se on. Muuttaa vaan ton viikkolaskurin
napin lisäämiseen montakin tapaa... lue helpistä

taulukon saa nopeimmin Exceliin seuraavasti

1. Avaa Excel ja Access
2. Accesissa klikkaa CRTL pohjassa sitä taulukkoa minkä haluat siirtää Exceliin ja raahaa se haluamaasi taulukon kohtaan Excelissä ja vapauta hiiren painike
aika cool...

lisää taulukko Koonti (oishan sen voinut koodillakin hoitaa, mutta pikaisesti näin nyt- nimeä sopivaksi tarvittaessa)

jos enemmän tyhjiä rivejä tartte niin muuta lukua isommaksi
ActiveCell.Offset(26, 0).Select

moduuliin...

Option Explicit

Sub Teetaulukko()
Dim vika As Long
Dim solu As Range
With Worksheets("Koonti")
.Activate
.Cells = ""
.Range("B1") = "viikko:"
.Range("B2") = "klo"
.Range("C1").Formula = "1"
LisääSarjat Range("C1"), 1, 52
LisääSarjat2 Range("A3")
End With
Worksheets("Taul1").Activate
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A3:A" & vika)
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") + 1, Format(solu, "ww") + 2) = solu.Offset(0, 1)
Next
Worksheets("Koonti").Cells.EntireColumn.AutoFit
End Sub

Sub LisääSarjat(solu As Range, Aloitus As Long, Määrä As Long)
With Worksheets("Koonti")
solu.Formula = Aloitus
solu.AutoFill Destination:=Range(solu.Address & ":" & solu.Offset(0, Määrä).Address), Type:=xlFillSeries
End With
End Sub

Sub LisääSarjat2(solu As Range)
Dim i As Long
With Worksheets("Koonti")
solu.Select
For i = 1 To 7
ActiveCell = UCase(WeekdayName(i))
ActiveCell.Offset(0, 1).Formula = "0"
ActiveCell.Offset(0, 1).AutoFill Destination:=Range(ActiveCell.Offset(0, 1).Address & ":" & ActiveCell.Offset(23, 1).Address), Type:=xlFillSeries
ActiveWorkbook.Names.Add Name:=ActiveCell, RefersTo:=Range(ActiveCell.Address & ":" & ActiveCell.Offset(23, 54).Address)
ActiveCell.Offset(26, 0).Select
Next
End With
End Sub

Keep EXCELing
@Kunde
makrolla piece of cake...

1. seurataan taulukossa muutosta- mikä solu muuttui?
2. haetaan esim. A sarakkeeesta työntekijän nimi muuttuneen solun rivin perusteella ja hänelle palkka palkkataulukosta ja lisätään esim solun ID:hen
3. suoritetaan palkanlasku käyttäen solun ID arvoa(palkka) ja solun arvoa (tunnit) ja summataan ne kumulatiivisesti johonkin tiettyyn soluun esim AK

jos ja kun palkka muuttuu niin käyttää aina sen hetkistä arvoa laskuissa ja laskelmat on päivälleen reaaliajassa. Tarvittaessa voi vielä takaperoisestikin korjata solun ID arvoja, joten palkkaa voi nostella/laskella ID arvoa muuttamalla...

ei ton kummosempi ja toimii... ;-)

Keep EXCELing
@Kunde
turhahan siinä on tehdä mitään ylimääräisiä taulukoita...
koodilla suoraan tiedostoon- piece of the cake ja taatusti maistuu hyvälle...

Keep EXCELing
@Kunde
joo bugi oli , muuttuja oli väärää tyyppiä sille ekalle solulle(String kun pitäs olla Date)...
Pikkuvika ja helppo korjata. Kumma, kun en itse huomannut testatessa tota eroa...

ActiveCell = Alku
ActiveCell = CDate(Alku)

mutta tossa korjattu versio

Option Explicit
Sub TäytäKuukaudet()
Dim Alku
Dim Loppu
Dim i As Long
Dim testi
Application.ScreenUpdating = False
uusi1:
Alku = Application.InputBox("Anna aloitus pvm muodossa 17.06.2011")
If Not IsDate(Alku) Then
MsgBox "päiväys virheellinen"
Alku = ""
GoTo uusi1
End If
uusi2:
Loppu = Application.InputBox("Anna lopetus pvm muodossa 17.06.2011")
If Not IsDate(Loppu) Then
MsgBox "päiväys virheellinen"
Loppu = ""
GoTo uusi2
End If

testi = MsgBox("Täytetäänkö kuukaudet väliltä " & Alku & " - " & Loppu & "?", vbInformation + vbYesNo)
If testi = 6 Then
ActiveCell = CDate(Alku)
For i = 1 To DateDiff("m", Alku, Loppu)
ActiveCell.Offset(i, 0) = DateSerial(Year(ActiveCell.Offset(i - 1, 0)), Month(ActiveCell.Offset(i - 1, 0)) + 1, Day(ActiveCell.Offset(i - 1, 0)))
Next i
Range(ActiveCell, ActiveCell.Offset(i - 1)).NumberFormat = "mmmm yy"
End If
Application.ScreenUpdating = True
End Sub
Keep EXCELing
@Kunde

kiitti palautteesta ;-)
turhan monimutkaista edellinen....
=TEKSTI(A1;"ppkkvv")
ei varsinaisesti excel vinkki vaan yleinen
jos haluat tulostaa kansiosta useamman työkirjan niin valitse tulostettavat työkirjat SHIFT /CTRL avulla ja klikkaa hiiren oikealla ja avutuvasta valikosta valitse tulosta....
jos haluat sulkea kaikki työkirjat kerralla niin SHIFT pohjassa klikkaa tiedosto menua ja siellä uusi komento sulje kaikki. Toki pitää vastata kyssärrin haluatko tallentaa muutokset, mutta silti kätevä....
jos haluat hieman erilaisia vaihtoehttoja kopiointiin/siirtoon, niin valitse alue ja klikkaa reunuksen päällä hiiren oikealla ja raahaa oikean paikkaan ja vapauta hiiren napin painallus ja avautuvassa valikossa eri vaihtoehtoja....
jos haluat piilottaa käyttämästäsi taulukosta kaavat niin...
valitse koko taulukko klikkaamalla vasemmassa yläkulmassa olevaa ruutua (sarake ja rivitunnuksien välissä). Klikkaa sitten hiiren oikealla ja avautuvasta valikosta valitse muotoile solut ja edelleen avautuvasta valikosta suojaus. Rujsaa kohta piilota ja OK. Suojaa taulukko salasanalla ja kopioi se sitten uuteen taulukkoon ja poista originelli taulukko ja tallenna. Nyt voit lähettää työkirjan eteenpäin ilman käyttämäsi kaavoja...
täyttää aktiivisesta solusta alaspäin valittujen päiväysten väliset kuukaudet

moduuliin...

Sub TäytäKuukaudet()
Dim Alku
Dim Loppu
Dim i As Long
Dim testi
Application.ScreenUpdating = False
uusi1:
Alku = Application.InputBox("Anna aloitus pvm muodossa 17.06.2011")
If Not IsDate(Alku) Then
MsgBox "päiväys virheellinen"
Alku = ""
GoTo uusi1
End If
uusi2:
Loppu = Application.InputBox("Anna lopetus pvm muodossa 17.06.2011")
If Not IsDate(Loppu) Then
MsgBox "päiväys virheellinen"
Loppu = ""
GoTo uusi2
End If

testi = MsgBox("Täytetäänkö kuukaudet väliltä " & Alku & " - " & Loppu & "?", vbInformation + vbYesNo)
If testi = 6 Then
ActiveCell = Alku
For i = 1 To DateDiff("m", Alku, Loppu)
ActiveCell.Offset(i, 0) = DateSerial(Year(ActiveCell.Offset(i - 1, 0)), Month(ActiveCell.Offset(i - 1, 0)) + 1, Day(ActiveCell.Offset(i - 1, 0)))
Next i
Range(ActiveCell, ActiveCell.Offset(i - 1)).NumberFormat = "mmmm yy"
End If
Application.ScreenUpdating = True
End Sub

Keep EXCELing
@Kunde
ei tuukaan...

siis pitääkö yhdistää 100 tiedostoa vaiko sata muuttujaa yhdestä tiedosotosta vaiko miten?
vaikeeta koodata näin ylimalkaisolla ohjeilla...
siis mistä haetaan ja mitä?
onko tiedot samassa soluissa aina vaiko eri soluissa?
mitä tyyppiä tieto on ja etsitäänkö sitä taulukosta vai onko se siis valmiina tietyissä soluissa
mihin kopioidaan ja miten (allekkain vierekkäin jne)?
...
...
...
28 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt