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

1377

  1. firmalaskuri soluista A19
    haluamaasi soluun kaava
    =Yritys("ky")

    missä ky on firmatyyppi (KY,Ky.kY,ky- käy kaikki kirjoitusasut...)
    muuta yhteenveto taulukon nimeä tarvittaessa, nyt yhteenveto ( muuttaa sen pieneksi joten ei ole väliä onko isoja tai pieniä kirjaimia)

    summalaskuri soluista B25
    haluamaasi soluun kaava
    =YritysSumma("ky")

    missä ky on firmatyyppi (KY,Ky.kY,ky- käy kaikki kirjoitusasut...)
    muuta yhteenveto taulukon nimeä tarvittaessa, nyt yhteenveto ( muuttaa sen pieneksi joten ei ole väliä onko isoja tai pieniä kirjaimia)

    moduuliin funktiot

    Option Explicit
    Function Yritys(Firmatyyppi As String) As Long
    Dim taulukko As Worksheet
    Dim löytyi As Variant

    On Error Resume Next
    Application.Volatile
    For Each taulukko In ActiveWorkbook.Worksheets
    If Not LCase(taulukko.Name) = "yhteenveto" Then
    Select Case LCase(taulukko.Range("A19"))
    Case LCase(Firmatyyppi)
    Yritys = Yritys + 1
    Case Else
    End Select
    End If
    Next taulukko
    End Function

    Function YritysSumma(Firmatyyppi As String) As Double
    Dim taulukko As Worksheet
    Dim löytyi As Variant

    On Error Resume Next
    Application.Volatile
    For Each taulukko In ActiveWorkbook.Worksheets
    If Not LCase(taulukko.Name) = "yhteenveto" Then
    Select Case LCase(taulukko.Range("A19"))
    Case LCase(Firmatyyppi)
    YritysSumma = YritysSumma + taulukko.Range("B25")
    Case Else
    End Select
    End If
    Next taulukko
    End Function

    Keep Excelling
    @Kunde
  2. pikkasen hakua peliin foorumilla ja kymmenkunta samantapaista casea ja mun vastaukset niihin löytyy...

    muutaman rivin muokkauksella
    taukoiden nimet nyt pohja ja valmiit ja haetaan A sarakkeesta vastineita

    moduuliin...
    Sub Siirrä()
    Dim Löydetty As Range
    Dim Solu As Range
    Dim vika As Long

    On Error Resume Next
    Application.ScreenUpdating = False
    Worksheets("valmiit").Activate
    vika = Range("A65536").End(xlUp).Row
    For Each Solu In Range("A1:A" & vika)
    Solu.Offset(0, 4) = EtsiJaSiirrä(Solu, Range("pohja!A:A"))
    Next Solu
    Application.ScreenUpdating = True
    End Sub


    Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
    Dim Solu As Range
    Dim EkaOsoite As String

    With HakuAlue
    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.Offset(0, 3)
    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
  3. taulukon moduuliin...
    nyt hakee solun K1 arvoja sarakkeista A-I ja ilmoittaa solun osoitteen, jos haluat että palauttaa sen ekan rivin kaapin nimen niin muutellaan sitten

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tulos As String
    On Error Resume Next
    If Not Intersect(Target, Range("K1")) Is Nothing Then
    tulos = EtsiJaNäytä(Range("K1"), Range("A:I")).Address
    If tulos = "" Then
    MsgBox "ei löytynyt!"
    Else
    MsgBox tulos
    End If
    End If
    End Sub

    ja moduuliin...

    Function EtsiJaNäytä(Hakuehto As Variant, HakuAlue As Range) As Range
    Dim solu As Range
    Dim EkaOsoite As String

    With HakuAlue
    Set solu = .Find( _
    What:=Hakuehto, _
    LookIn:=xlValues, _
    LookAt:=xlWhole, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False)
    If Not solu Is Nothing Then
    Set EtsiJaNäytä = solu
    EkaOsoite = solu.Address
    Do
    Set EtsiJaNäytä = Union(EtsiJaNäytä, solu)
    Set solu = .FindNext(solu)
    Loop While Not solu Is Nothing And solu.Address EkaOsoite
    End If
    End With
    End Function
  4. kerran mun viestistä katosi osa kanssa,eikä saanut millään lähetettyä kaavaa
  5. 4. Tools/Options ja Calculation välilehdeltä vois kokeilla Calculation Manual vaihtoehtoa...
    klikkaamalla F9 päivität sitten taulukon
    tai sitten lähetä filu [email protected] ja tsekkaan jospa se vaan on konekohtainen probleemi...
  6. ja tosiaan peruskauraa... ei edes ½ kupillista kahvia mennyt ;-)

    taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    If Not Intersect(Target, Range("E:F")) Is Nothing Then
    Target.Offset(0, -3) = Target.Offset(0, -3) + Target
    Target = ""
    End If
    Application.EnableEvents = True
    End Sub
  7. tosi helppoa muokata tommosia...
    ;-)
  8. moduuliin...
    Function HaeSana(Solu As Range, Erotin As String, MontakoSanaa As Integer) As String
    Dim a As Variant
    Dim i As Long
    On Error GoTo virhe
    a = Split(Solu, Erotin)
    For i = 0 To MontakoSanaa - 1
    HaeSana = HaeSana & a(i) & " "
    Next i
    HaeSana = RTrim(HaeSana)
    Exit Function
    virhe:
    HaeSana = "VIRHEELLINEN TIETO!"
    End Function

    HaeSana(Solu As Range, Erotin As String, MontakoSanaa As Integer)

    käyttäjän määrittelemässä funktiossa

    Solu = solu mistä tietoa haetaan
    Erotin= välimerkki sanojen välillä
    MontakoSanaa= montako sanaa palautetaan vasemmalta lukien
    eli
    soluun kaava =HaeSana(A1;" ";2)

    palauttaa solusta A1 2 sanaa jotka on erotettu välilyönnillä...
    virhetilaanteessa soluun teksti VIRHEELLINEN TIETO! (liian monta sanaa tai virheellinen erotin)

    Keep Excelling
    @Kunde
  9. Tallenna työkirja webbimuodossa ja sulje. Avaa nyt toi webbitallennus ja tallenna normaalina excel työkirjana. Poista webbitallennus...
  10. Ei se tiedoston koko kaikkea totuutta kerro, vaikkakin mitä isompi koko tietenkin tallennus kestää kauemmin.
    1. Mikä versio? 2007 kanssa on ongelmia
    2. Onko kone verkossa? Onko kaikki asemat avoinna? Jos ei ole verkkoyhteyttä avoinna vaikuttaa kyllä paljon. Onko serveri? Onko siinä sama käyttis kuin omassa koneessasi. Jos on aiempaa versiota niin...
    3. Onko virustorjuntaa ja onko verkkoskannaus päällä?
    4. Uudelleenlaskenta manuaalille ennen tallennusta- auttaako. Voisit tehdä koodiin BeforeSave() tapahtumaan koodiinpätkän tolle ja tallentaa, sitten uudelleenlaskenta takaisin automaatille ja lopuksi cancel=true
    5. Yrität tallentaa tiedostoa tikulle tai ulkoiselle kovalevylle...
    6. Koodin voisit tallentaa(export) tekstitiedostoihin ja poistaa kaikki moduulit ja sitten tuot (import) takaisin
    7. Etsi löytyykö .xlb tiedosto ja poista se
    8. Tyhjennä TMP kansiot

    kyllä noilla nyt pitäisi nopeutua jonkinverran toiminnot...


    Keep Excelling
    @Kunde
  11. Käytössä on 4 eri viikkonumerosysteemiä

    1. ISO
    - viikko alkaa maanantaina. Viikko 1 alkaa sen viikon maanantaina, joka ensimmäisen kerran sisältää torstain

    2. Excel WEEKNUMBER viikko alkaa sunnuntaina (toinen argumentti=1)
    - viikko alkaa 1.1 ja viikko 2 alkaa seuraavana sunnuntaina

    3. Excel WEEKNUMBER viikko alkaa maanantaina (toinen argumentti=2)
    - viikko alkaa 1.1 ja viikko 2 alkaa seuraavana maanataina

    4. viikko 1 alkaa aina 1.1, viikko 2 alkaa 8.1 ja viikko 53 sisältää 1 tai 2 päivää(karkausvuosi)

    Excelissä ei ole vakiona kohtien 1. ja 4. mukaisia viikkolaskureita

    kaava ISO viikkolaskurille ja viikot toimii niinkuin ISO standardi määrää...
    esim päiväys solussa E1

    =INT((E1-DATE(YEAR(E1-WEEKDAY(E1-1)+4);1;3)+WEEKDAY(DATE(YEAR(E1-WEEKDAY(E1-1)+4);1;3))+5)/7)

    @Keep Excelling
    Kunde
  12. "Vinkkinä että nuo hakualueet kannattaa tehdä alussa heti tarpeeksi suuriksi, ettei tarvitse sitten jälkeenpäin korjata niitä kaikkiin kaavoihin,jos tietoa tulee jatkuvasti lisää."

    oikeaoppisesti ne kyllä pitää tehdä dynaamisiksi..
    eli aina kun tietoa tulee lisää tai vähennetään niin "tietoalue" muuttuu kanssa kaavassa
    harmia vaan tommosilla alueiden ylimitoittamisilla saa aikaan...
  13. A1=aika
    A2=A1/86400000
    solumuotoilu t:mm:ss,00
  14. moduuliin...

    Option Explicit

    Sub KorostaJaSiirräTuplat()
    Dim solu As Range
    Dim Vika As Double
    Dim Alue As Range
    Dim i As Long
    Vika = Range("A65536").End(xlUp).Row
    Set Alue = Range("A1:A" & Vika)
    i = 1
    'tyhjennetään arvot B-sarakkeesta
    Range("B:B") = ""

    ' värjätään tuplat A-sarakkeessa
    For Each solu In Alue
    If WorksheetFunction.CountIf(Alue, solu.Value) = 1 Then
    ' ei taustaväriä uniikiarvoille
    solu.Interior.ColorIndex = xlNone
    Else
    ' keltainen tupla-arvoille, vaihda värinumeroa tarvittaessa
    solu.Interior.ColorIndex = 6
    ' siirretään tupla-arvot B-sarakkeeseen
    ' muistettava tarkistaa aluksi tyhjänä oleva alue kanssa!!!
    If WorksheetFunction.CountIf(Range("B:B"), solu.Value) = 0 Then
    Range("B" & i) = solu.Value
    i = i + 1
    End If
    End If
    Next solu
    'lajitellaan lopuksi
    Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortTextAsNumbers
    End Sub

    @Keep Excelling
    Kunde
  15. Avaa tyhjä dokkari ja INSERT/FILE (tiedosto 1)
    Tee osanvaihto ja siirry tyhjälle sivulle ja poista tunnisteesta linkki edelliseen. Lisää nyt samalla tavalla tiedosto 2
    Näyttäs ainakin toimivan Excel 2003
    @Kunde
  16. JOS(A1;"X";"")
  17. oma moka kun otin sen omista ohjeistani progressiivisestä hinnoittelusta ...
    silloin sitä tarvitaan- ei siis nyt
    sorry
  18. se noin onnistuu, mutta samalla lähtee sitten sanojen välistäkin tyhjät. Oletin, että sulla mahdollisesti tekstiäkin (useiampi sana samassa solussa) riveillä, joten sen takia trim.
  19. excelissä piece of the cake
    lue tuolta http://keskustelu.suomi24.fi/node/4025056

    pikku muutoksella esim.

    taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    LisääID Target
    Application.EnableEvents = True
    End Sub

    moduuliin...

    Sub LisääID(Solu As Range)
    Dim edellinen As String
    Dim nykyinen As String
    On Error Resume Next
    With Solu.Cells(1, 1)
    edellinen = .ID
    .ID = ""
    If Len(.Formula) > 0 Then
    nykyinen = .Value
    Select Case UCase(nykyinen)
    'lisää tässä näppäinyhdistelmä muutoksia
    Case "Z"
    nykyinen = "C1"
    Case "X"
    nykyinen = "D1"
    Case Else
    nykyinen = ""
    End Select
    .Formula = edellinen + nykyinen
    .ID = CStr(edellinen + nykyinen)
    End If
    On Error GoTo 0
    End With
    End Sub
  20. moduuliin...
    Sub Macro1()
    Dim solu As Range
    On Error Resume Next
    For Each solu In Range("A1:M10000")
    solu.Value = Trim(solu.Value) + 0
    Next
    End Sub
    21. 48 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt