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
taulukon moduuliin...
muuta solut sopiviksi nyt
A1=kaava
A2= solu, mihin tulos siirretään


Private Sub Worksheet_Change(ByVal Target As Range)
Static vanha
On Error Resume Next
Application.EnableEvents = False
If vanha = Empty Then
vanha = Range("A1")
End If
If Range("A1") > vanha Then
Range("A2") = Range("A1")
End If
vanha = Range("A1")
Application.EnableEvents = True
End Sub
näinmäätonlaskisin...
kaavasi ei kylläkään laske solusta D3 alaspäin soluissa olevien ikien keskiarvoa?

Ihan perustasolla toi munkin juttu on. Jos osaa kopioida kaavat moduuliin niin sen jälkeen löytyy kaavat normaali kaavaluettelosta ja loppu on ihan samaa kuin käyttäisit "peruskaavoja" lisää funktion avulla, mutta nyt hommat vaan paljon helpommalla. Esim. olkoon nyt ikä mallina kaavasta

soluun kaava =ikä()
ja laskee automaattisesti D3 alaspäin keskiarvon ijille. Jos tarttee muuttaa aluetta ei ole iso ongelma, muuttaa yhdellä kaavarivillä osoitetta, toisin kuin dynaamisella "perustason kaavalla", jonka ehkä saat nikkaroitua. Katellaan mitä tuleman pitää...

Vaikeatako?

Keep VBAing
@Kunde
moduuliin...

souun kaava esim. =kulutus("B1";"B2";"C1";"C2"),
jossa B1=alkupvm
jossa B2=loppupvm
jossa C1=alkulukema
jossa C2=loppulukema

soluosoite voi olla mikä vaan

Function Kulutus(Alkupvm As String, Loppupvm As String, Alkulukema As String, Loppulukema As String) As Double
Dim kokokulutus As Double
Application.Volatile True
pvlkm = CDate(Range(Loppupvm)) - CDate(Range(Alkupvm))
kokokulutus = Range(Loppulukema) - Range(Alkulukema)
Kulutus = Int(365 / pvlkm * kokokulutus)
End Function

laskee nyt D3 alaspäin viimeiseen soluun keskiarvon ijille(= mitenkähän pitäs kirjottaa ;-)). Kaavasolussa sitten säätelet desimaalit sopivaksi solumuotoilulla...


Function ikä() As Double
Dim vika As Long
Dim syntymäaika As Double
Dim ikäka As Double
Dim laskuri As Long
Application.Volatile True
vika = Range("D65536").End(xlUp).Row

For Each solu In Range("D3:D" & vika)
laskuri = laskuri + 1
syntymäaika = CDate(solu)
ikä = ikä + CDate(Date) - CDate(syntymäaika)
Next
ikäka = ikä / laskuri
ikäka = DateDiff("m", Date - ikäka, Date)
ikä = ikäka / 12
End Function


Keep EXCELing
@Kunde
ilman koodaamista.

Mikäs kaava toi osamäärä on kun oma Excelini ei tunnista sitä? Pitäisiköhän olla jakojännös JAKOJ?
Omalla funktiolla onnaa helposti luuppaamalla ja palautta molemmat tarvittavat arvot kaavasolu= osakaavojen lkm ja vaikkapa oikeanpuoleiseen soluun= osakaavan tulos

ja soluun mihin haluat tuloksen simppeli kaava kaava esim. =osakaava

Keep Excelling
@Kunde
j = Int(ActiveSheet.UsedRange.Rows.Count / 50)
For i = 1 To j
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(i * 50 + 1, 1)
Next i

ThisWorkbook moduuliin...

Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.ResetAllPageBreaks
ActiveSheet.PageSetup.PrintArea = "$A$1:$U$72"
ActiveSheet.PageSetup.Zoom = 60
ActiveWindow.View = xlPageBreakPreview
Set ActiveSheet.VPageBreaks(1).Location = Range("L1")
ActiveWindow.View = xlNormalView
End Sub
onnistuu ihan jees vaikkapa taulukon Worksheet_SelectionChange tapahtumassa...
ja klikkaamalla kirjainmerkkiä pääset siihen kohtaan missä se termi on...
eli kumpikin pyynnöistäsi toteutuu kirjainmerkillä...
tee termille kirjainmerkki ja se on siinä...
Jos noita on paljon niin koodia se kaipaisi tietenkin!

mutta siis kirjainmerkki ja nauhoita sitten vaikka makro, joka avaa kirjainmerkkilomakkeen ja siellähän ne termisanat(kirjainmerkit jos olet ne nimennyt samaksi) on automaattisesti aakkostettuna luetteloruudussa...

Keep Wording
@Kunde
taas pelaa foorumi, eikä olla bannattuna )-;

haullahan näitä samoja kyssäreitä alkaa olla jo piisalle asti (mielestäni paras RANGE-funktio)...
ei tartte yleensä kuin solualueen ja tarpeen muutoksen- eli pikku fiksauksen.
Liian VAIKEAAKO???

moduuliin...

Function EtsiJaSiirrä(Hakuehto As Variant) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Taul1").Activate
With Range("C3:X3")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function

Sub Testi2()
On Error Resume Next
Dim Löydetty As Range
Dim solu As Range
Set Löydetty = EtsiJaSiirrä("")
Löydetty.EntireColumn.Delete
Set Löydetty = EtsiJaSiirrä(0)
Löydetty.EntireColumn.Delete
End Sub
mutta suomennosta asiaan...
Eli tehtävänä on luoda sovellus pienelle yritykselle, joka toimii puualalla. Liitteenä on ollut malli sovellutuksesta, eli varmaankin kuvaruutukaappaus(uksia) tauluko(i)sta.
Työkirjassa käytetään erikoissuodatusta myyntimiehen tietojen saamiseksi Salesman taulukosta My_Salesman taulukkoon. Tehtävänäsi on käyttää maita, jotka on määritelty harjotustyö numerossasi (annettu harjoitustyö paperilla
Huomaa myös, että kaikkia Salesman taulukon kenttiä ei tarvita My_Salesman taulukossa ja niiden järjestys ei tarvitse olla sama( valmistaudu selittämään miten erikoissuodatus toimii).
Lajittele My_Salesmen taulukko käyttäen erikoissuodatusta ja tee se maan ja nimen mukaan.

sitten vaan phakua, suodatusta, erikoissuodatusta, indeksiä, vastinetta, jossia, pvmfunktioita, tekstifunktioita, absoluuttista osoitusta yms. peliin kyllä se siitä helpostikin...

LYCKA TILL!
1. Vasemmassa yläkulmassa olevaa Excelkuvaketta klikkaat hiiren oikealla ja aukeavasta valikosta klikkaat View Code/Näytä Koodi.
Tai käytät näppäinyhdistelmää ALT+F11
2. VBE näkymässä sitten valikosta INSERT/MODULE
3. Sitten vain kopioit koodin oikealla olevaan ikkunaan
4. Teet napin tms. ja liität koodin siihen.
Tai koodipuolella klikkaat hiirellä ekan koodipätkän jollekin riville sanojen Sub Lotto- End Sub välille ja sitten F5

@Kunde
nyt on...
soluun kaava esim testataan onko solussa A1 kommentti?
=OnkoKommenttia(A1)
vaatii päivittyäkseen muutoksen taulukossa

moduuliin...

Function OnkoKommenttia(Solu As Range) As Boolean
On Error Resume Next
Application.Volatile True
OnkoKommenttia = Solu.Comment.Parent.Address = Solu.Address
On Error GoTo 0
End Function

Keep Excelling
@Kunde
olettaen, ettei tuplia sallita
rivillä 1 tekstit A1=luku1, B1=luku2 jne...

moduuliin...


Sub Lotto()
Dim luku1 As Variant
Dim luku2 As Variant
Dim luku3 As Variant
Dim luku4 As Variant
Dim vara As Variant
Range("A2:E1510") = ""

For Each luku1 In Array(1, 2, 3)
For Each luku2 In Array(4, 5, 6, 7)
For Each luku3 In Array(8, 9, 0, 1, 2)
For Each luku4 In Array(3, 4, 5, 6, 7)
For Each vara In Array(8, 9, 0, 1, 2)
Range("A65536").End(xlUp).Offset(1, 0) = luku1
Range("A65536").End(xlUp).Offset(1, 1) = luku2
Range("A65536").End(xlUp).Offset(1, 2) = luku3
Range("A65536").End(xlUp).Offset(1, 3) = luku4
Range("A65536").End(xlUp).Offset(1, 4) = vara
Next
Next
Next
Next
Next
Poistatuplat
End Sub

Sub Poistatuplat()
Dim vika As Long
Dim Alue As Range
Dim Solu As Range
Dim i As Long
vika = Range("E65536").End(xlUp).Row
For i = vika To 2 Step -1
Set Alue = Range("A" & i & ":E" & i)
For Each Solu In Alue
If WorksheetFunction.CountIf(Alue, Solu.Value) > 1 Then
Solu.EntireRow.Delete
End If
Next
Next
Range("A2").EntireRow.Delete
End Sub
Function EtsiJaSiirrä2(Hakuehto As Variant, Taulukko As String, Alue As String) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets(Taulukko).Activate
With Range(Alue)
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä2 = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function

Sub Testi2()
Dim Löydetty As Range
Dim solu As Range
Dim laskuri As Integer
Sheets("viat").Rows("2:65536").Delete
Range("A2").Select
Set Löydetty = EtsiJaSiirrä2("vika", "välilehti1", "I:I")
If Not Löydetty Is Nothing Then
For Each solu In Löydetty
Union(solu.Offset(0, -8), solu.Offset(0, -7), solu.Offset(0, -6)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
laskuri = laskuri + 1
Next
End If

Set Löydetty = EtsiJaSiirrä2("vika", "välilehti2", "I:I")
If Not Löydetty Is Nothing Then
For Each solu In Löydetty
Union(solu.Offset(0, -8), solu.Offset(0, -7), solu.Offset(0, -6)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
laskuri = laskuri + 1
Next
End If

Set Löydetty = EtsiJaSiirrä2("vika", "välilehti3", "E:E")
If Not Löydetty Is Nothing Then
For Each solu In Löydetty
Union(solu.Offset(0, -4), solu.Offset(0, -3), solu.Offset(0, -2)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
laskuri = laskuri + 1
Next
End If

Set Löydetty = EtsiJaSiirrä2("vika", "välilehti4", "E:E")
If Not Löydetty Is Nothing Then
For Each solu In Löydetty
Union(solu.Offset(0, -4), solu.Offset(0, -3), solu.Offset(0, -2)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
laskuri = laskuri + 1
Next
End If

Set Löydetty = EtsiJaSiirrä2("vika", "välilehti5", "E:E")
If Not Löydetty Is Nothing Then
For Each solu In Löydetty
Union(solu.Offset(0, -4), solu.Offset(0, -3), solu.Offset(0, -2)).Copy Range("viat!A65536").End(xlUp).Offset(1, 0)
laskuri = laskuri + 1
Next
End If
If laskuri = 0 Then
MsgBox "Ei vika tapauksia!", vbInformation
Else
MsgBox "vika tapauksia löytyi " & laskuri & " kpl!", vbInformation
End If
End Sub
toi koodin pätkä.
Mutta jos siis haluat tehdä kaavion ja lisätä siihen trendiviivan, niin miksi et lisää sitä heti kun teet kaavion?
Jotain tämöstä siis, eli ei ole viitausongelmia...

Sub LisääKaavio()
With ActiveSheet.ChartObjects.Add(Left:=300, Width:=400, Top:=50, Height:=300)
.Chart.SetSourceData Source:=Sheets("Sheet1").Range("A1:A10")
.Chart.ChartType = xlXYScatter
.Chart.SeriesCollection(1).Trendlines.Add
.Chart.SeriesCollection(1).Trendlines(1).DisplayEquation = True
.Chart.SeriesCollection(1).Trendlines(1).DisplayRSquared = True
End With
End Sub
mahdotonta neuvoa noilla tiedoilla...
aluksi nyt tarkennusta ja koodia peliin...
Kyllä makrojen pitäisi periaatteessa toimia nopeammin. Eroa tuskin huomaa ennenkuin kyseessä on sitten isot työkirjat ja paljon laskentaa ja editointia ja taustalla paljon avoimia ohjelmia.

hiukan valaisua asiaan

32 bittisen max muistin käyttö on 4GB, mikä rajoittaa siis myös Excelin nopeutta jos avoimia ohjelmia, työkirjoja on enmmän auki. Eli joutuu sumplimaan vapaan tilankäytön kanssa. Toisaalta on turha asentaa muistia koneeseen yli 4 GB jos käytössä on 32 bittinen systeemi, koska se ei voi käyttää yli 4 Gb muistiavaruutta!
64 biitisen muistiavaruus on sitten jo 17 miljoonaa GB. Tästä syystä muistiakin on enemmän käytössä olettaen, että koneessa itsessäänkin on lisätty tarpeeksi muistikampoja... )-;

Kumpi versio sitten 64 bittiseen windowsiin?

Oletuksena Office asentuu aina 32 bittisenä.

Jos tiedostokoot excelissä on alle 2GB ja ei tehdä massiivisia toimituksia parempi pysytellä 32 bittisessä versiossa. Jos 64 bittinen Windows niin se rajoittaa 32 bittisten excelmakrojen käyttöä, koska 64 bittinen ei tue 32 biitisiä ActiveX , COM ja monia 3 osapuolentekemiä apuohjelmia, sekä Excelin omia kontrolleja aikaisemmista versioista jotka ovat vain 32 bittisiä.
64 bittisessä officessa voit tehdä koodia myös 32 bittisenä, mutta pitää varmistaa, että oikeat muuttujat ovat käytössä 64 bittisessä tehdyssä koodissa, jotta se toimisi myös aiemmissa versioissa. Eli voit tehdä koodia "jossittelemalla", joka sitten toimii sekä 32 bittisessä, että 64 bittisessä ympäristössä
Ongelmat voidaan korvata käännösohjelmilla. Ei oo tietoa kuinka hyvin toimii?

eli summa summarum
el ihyvällä säkääl 32 bittinen makro siis toimii nopeammin, mutta ei kuitenkaan 2 kertaa vaan luokkaa 1.2-1.5. Jostain foorumilta luin , että odottavat ekaa koodin pätkää, joka toimisi 2 kertaa nopeammin, mutta eipähän ole vastauksia näkynyt...
Siis ainoa hyöty tällä hetkellä on isojen tiedostojen yli 2 GB käyttö 64 bittisellä...

toka kyssäri
onnistuu...
muodostat excel objektin ja sitten koodissa jotai tommosta
esim. suorittaa ExcelApp-objektissa makron TestiMakro. Makrollehan voi syöttää myös parametrejä, mutta ohjeethan löytyy helpistä.

ExcelApp.Run('TestiMakro')
muuta koodirivi
If Not Intersect(Target, Range("C13")) Or Not Intersect(Target, Range("G13")) Is Nothing Then

seuraavaksi...
If Not Intersect(Target, Range("C13")) Is Nothing Or Not Intersect(Target, Range("G13")) Is Nothing Then

Keep Excelling
@Kunde
jos hakuehto on tyhjä niin mitäs sitten pitäs näyttää???
ei mulla oo kristallipalloa...

Keep Excelling
@ Kunde
kun laiskottaa ja ei testaa.
SORRY
Oletin kyllä koodin toimivan ilman testausta..
No ei enää sitten postauksia ilman testausta prkl

tää nyt ainakin mulla toimii molemilla sarakesuodatuksilla

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vika As Integer
Dim solu As Range

On Error Resume Next

Application.EnableEvents = False
If Not Intersect(Target, Range("C13")) Or Not Intersect(Target, Range("G13")) Is Nothing Then
If Target = "" Then
ActiveSheet.ShowAllData
End If
End If
If Not Intersect(Target, Range("C13")) Is Nothing Then
If Target = "" Then
Range("G13") = ""
GoTo poistu
End If
ActiveSheet.ShowAllData
vika = Range("C65336").End(xlUp).Row
Range("C13:G" & vika).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
For Each solu In Range("C14:C" & vika).SpecialCells(xlCellTypeVisible)
If Not solu = Range("C13") Then
solu.EntireRow.Hidden = True
End If
Next solu
Range("G13") = ""
End If
If Not Intersect(Target, Range("G13")) Is Nothing Then
If Target = "" Then
Range("C13") = ""
GoTo poistu
End If
ActiveSheet.ShowAllData
vika = Range("C65336").End(xlUp).Row
Range("C13:G" & vika).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
For Each solu In Range("G14:G" & vika).SpecialCells(xlCellTypeVisible)
If Not solu = Range("G13") Then
solu.EntireRow.Hidden = True
End If
Next solu
Range("C13") = ""
End If
poistu:
Application.EnableEvents = True
End Sub

Sub Resetoi()
On Error Resume Next
Application.EnableEvents = True
ActiveSheet.ShowAllData
End Sub

Keep Excelling
@Kunde
40 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt