kunde
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 sitten
Muokkaa profiilia7 aloitusta · 1377 kommenttia
- 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) kunde@hotmail.fi.
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)?
...
...
...