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. 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
  2. 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
  3. onnistuu ihan jees vaikkapa taulukon Worksheet_SelectionChange tapahtumassa...
  4. ja klikkaamalla kirjainmerkkiä pääset siihen kohtaan missä se termi on...
    eli kumpikin pyynnöistäsi toteutuu kirjainmerkillä...
  5. 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
  6. 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
  7. 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!
  8. 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
  9. 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
  10. 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
  11. 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
  12. 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
  13. mahdotonta neuvoa noilla tiedoilla...
    aluksi nyt tarkennusta ja koodia peliin...
  14. 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')
  15. 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
  16. jos hakuehto on tyhjä niin mitäs sitten pitäs näyttää???
    ei mulla oo kristallipalloa...

    Keep Excelling
    @ Kunde
  17. 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
  18. mokahan siinä on...
    oli väärässä paikkaa toi "näytä kaikki" koodirivi

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

    On Error Resume Next
    vika = Range("C65336").End(xlUp).Row
    Application.EnableEvents = False

    If Not Intersect(Target, Range("C13")) Is Nothing Then
    ActiveSheet.ShowAllData
    If Target = "" Then
    Range("G13") = ""
    GoTo poistu
    End If
    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
    ActiveSheet.ShowAllData
    If Target = "" Then
    Range("C13") = ""
    GoTo poistu
    End If
    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
  19. kokeiles koodissa seuraavaa
    klikkaa hiiren vaemmalla rivien välissä
    Private Sub Worksheet_Change(ByVal Target As Range)
    ...
    End Sub

    sitten klikkailet F8 ja tutkaile koodissa seuraavaa riviä. (Voi tän tehdä fiksumminkin , mutta hankala selittää...)
    Vie hiiri solu sanan päälle ja tsekkaa sen arvo samoin tee Range("C13") sanalle. Vertaile näytettyjä arvoja ja tutki mikä ero niillä on? Ettei vaan olisi ylimääräisiä merkkejä soluissa? Jos näin on niin sitten koodin trimmikomentoa tai pituuden tarkistusta yms...

    If Not solu = Range("C13") Then
  20. sillä voit suodattaa niitä lukuja C sarakkeessa samanlailla kuin kuukausilla G sarakkeessa- et sitä sitten näköjään tarvinnut... ;-)

    kiitos palautteesta!

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