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. ainakin mulla toimii 2003 versiossa tää

    Sub Testi()
    On Error GoTo virhe:
    Dim löydetty As Range
    Set löydetty = EtsiJaSiirrä("d", Columns("m:m")).EntireRow
    Union(löydetty, löydetty).Copy Range("Sheet2!A65536").End(xlUp).Offset(1, 0).EntireRow
    Exit Sub
    virhe:
    MsgBox "Hakuehdollasi ei löytynyt yhtään tietuetta!"
    End Sub


    Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets("Sheet1").Activate
    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
    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
  2. - toistetaan sama kuin kohdat 1 ja 2, sillä erolla, että vuosi on muutettu elettäväksi vuodeksi. Tiedot tuodaan kohtiin H 6 ja F 6
    eli nyt siis katsastusaika ton mukaan olisi esim H6=23.2.2011 ja F6=23.10.2011

    onkos tuolla Exceliin.xls T sarakkeessa pvm tälle vuodelle vai mikä pvm siellä on?

    ei mennnyt vieläkään jakeluun...
  3. ymmärsiköhän nyt oikein...

    aktiivisessa taulukossa
    solu G3 = hakuehto etsitää EXCELIIN.xls sarakkeesta C
    solu H3 = Exceliin.xls solu hakuehdon riviltä AC-sarakkeen tieto
    solu I3 = Exceliin.xls solu hakuehdon riviltä AC- sarakkeen tieto - 4 kk
    solu J3 = Exceliin.xls solu hakuehdon riviltä T-sarakkeen tieto
    jos J3>=H3 niin solu K3= ylittynyt muuten =""

    mutta sitten...
    Edellisen lauseen ilmoitus näytölle toteutuisi vain jos solun T arvo ei sovi solun AC ja sen miinustettuun neljä kuukautta arvojen raameihin...
    mielestäni ristiriita edellisen väittämän kanssa...
    mutta tosssa tähän astinen koodi ilman ilmoitusta...

    taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Not Intersect(Target, Range("G3")) Is Nothing Then
    HakeeSuljetusta
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    End Sub

    moduuliin...

    Sub HakeeSuljetusta()
    Dim wb As Workbook
    Dim Löydetty As Range
    Set wb = Workbooks.Open("C:\Exceliin.xls", True, True)
    Set Löydetty = EtsiJaSiirrä(ThisWorkbook.Worksheets("Sheet1").Range("G3"), Range("C:C"))
    With ThisWorkbook.Worksheets("Sheet1")
    .Range("H3") = DateSerial(Year(Löydetty.Offset(0, 26)), Month(Löydetty.Offset(0, 26)), Day(Löydetty.Offset(0, 26)))
    .Range("I3") = DateSerial(Year(Löydetty.Offset(0, 26)), Month(Löydetty.Offset(0, 26)) - 4, Day(Löydetty.Offset(0, 26)))
    .Range("J3") = DateSerial(Year(Löydetty.Offset(0, 17)), Month(Löydetty.Offset(0, 17)), Day(Löydetty.Offset(0, 17)))
    If .Range("J3") = .Range("I3") Then
    .Range("K3") = ""
    Else
    .Range("K3") = ""
    End If
    End With
    wb.Close False
    Set wb = Nothing
    End Sub
    Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets("Sheet1").Activate
    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
    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
  4. ei tartte kikkailla kun lisäät

    ThisWorkbook moduuliin...

    Sub Auto_Open()
    Application.OnKey "{RIGHT}", "Oikealle"
    Application.OnKey "{LEFT}", "Vasemmalle"
    Application.OnKey "{UP}", "Ylös"
    Application.OnKey "{DOWN}", "Alas"
    End Sub
  5. taulukon moduuliin...

    Option Explicit

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.OnKey "{RIGHT}", "Oikealle"
    Application.OnKey "{LEFT}", "Vasemmalle"
    Application.OnKey "{UP}", "Ylös"
    Application.OnKey "{DOWN}", "Alas"
    End Sub

    tavalliseen moduuliin...(koodin pätkät resetoinnille ja käytöstä poistoon kanssa)

    Option Explicit

    Sub Oikealle()
    MsgBox "oikealle"
    End Sub
    Sub VAsemmalle()
    MsgBox "vasemmalle"
    End Sub
    Sub Ylös()
    MsgBox "ylös"
    End Sub
    Sub Alas()
    MsgBox "alas"
    End Sub
    Sub Poistaakäytöstä()
    Application.OnKey "{RIGHT}", ""
    Application.OnKey "{LEFT}", ""
    Application.OnKey "{UP}", ""
    Application.OnKey "{DOWN}", ""
    End Sub
    Sub Resetoi()
    Application.OnKey "{RIGHT}"
    Application.OnKey "{LEFT}"
    Application.OnKey "{UP}"
    Application.OnKey "{DOWN}"
    End Sub

    Keep EXCELing
    @Kunde
  6. Option Explicit
    Sub a()
    Dim i As Long
    Dim vika As Long
    vika = Range("A65536").End(xlUp).Row
    Sheets("Taul1").Activate
    For i = 4 To vika Step 10
    Range("A" & i & ":A" & i + 9).Copy Range("C65536").End(xlUp).Offset(1, 0)
    Next
    End Sub

    Keep EXCELing
    @Kunde
  7. A1!=kurssi lev/euro
    B1=kurssi euro/lev
    C!=EURO
    D1=LEV
    syötä sitten C2 tai D2 arvoja ja homma toimii ...

    taulukon moduuliin...
    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.Enable
    Events = False
    If Not Intersect(Target, Range("C2")) Is Nothing Then
    Range("D2") = Range("B1") * Range("C2")
    End If
    If Not Intersect(Target, Range("D2")) Is Nothing Then
    Range("C2") = Range("B1") * Range("D2")
    End If
    Application.EnableEvents = True
    End Sub

    Keep EXCELing
    @Kunde
  8. Tilarivillä kun klikkaat hiiren oikealla tekstin NUM päällä voit valita mitä näytetään kun teet valinnan- summa, max, min jne...
    eli kun valitset soluja näet tilarivillä valinnan mukaiset tiedot
  9. jos haluaa numerosarjan ilman, että kirjoittaa esim A1=1 ja A2= 2 ja valitsee molemmat solut ja raahaa
    ei tarvitse kuin kirjoittaa A1=1 ja CTRL pohjassa raahaa sarjan
  10. jos työkirja sisältää useita taulukoita ja kyllästyttää scrollata taulukkonäppäimistä (ja jos et tiedä onko haluamasi taulukko alkuunpäin vaiko loppuunpäin) niin hiiren oikealla klikkaa nuolinäppäinten kohdalta ja avautuvasta valikosta valitse haluamasi taulukko
  11. jos olet tehnyt kaavion ei dynaamisena ja haluat nopeasti lisätä siihen uutta tietoa ilman uudellen tekoa niin maalaat lisättävä tietoalue ja rahaa se hiiren oikealla kaavioalueelle ja vapauta ja uudet tiedot päivittyvät kaavioon
  12. jos haluat nopeasti tehdä esim summakaavat sarakkeeseenn...
    aktivoi solu ja tee kaava esim. C1 = A1+B1 tuplaklikkaa solu oikeaa nurkkaa(pientä mustaa neliötä) ja vola` kaavat ilamn raahaamista. Toimii jos vasemmalla tai oikealla puolella on yhtenäinen alue siis stoppaa ekaan tyhjään viereiseen soluun.
    Jos molemmin puolin on tietoa vasemmanpuoleinen sarake voittaa...
  13. kun haluat nopeasti siirtyä ison alueen jonkin sarakkeen viimeiseen soluun aktivoi sen sarakkeen joku solu ja ja tuplaklikkaa solun alareunan kehyksen päällä (kursosi muuttuu ekaksi 4 nuoliseksi). Vastaavasti oikealle viimeinen solu tuplaklikkaaa oieata sivua jne...
  14. kun haluat täyttää solualueen jollakin sarjalla esim. kuukausilla voi raahata hiiren oikealla ja avautuvasta valikosta valitset sopivat vaihtoehdot myös askelluksellekin
  15. Option Explicit
    Sub HarjoitusMakro()
    'määitellään rivimuuttuja, parempi käyttää long muotoa kun muuttaa kuitenkin integer --->long
    Dim vika As Long
    'vika rivi sarakkeesta A
    vika = Range("A65536").End(xlUp).Row
    'kaava soluun C1 =A1+B1
    Range("C1").FormulaR1C1 = "=RC[-2]+RC[-1]"
    'käytetään automaattitäyttöä... vastaa raahaamista fiksumpi tapa kuin loopata ;-)
    Range("C1").AutoFill Destination:=Range("C1:C" & vika), Type:=xlFillDefault
    'samat jutut D sarakkeeseen...
    Range("D1").FormulaR1C1 = "=IF(RC[-3]+RC[-2]
  16. hiukan on ylimalkainen kyssäri tyylin "mulla on maha kipee mistähän johtuu"
    Onko työkirjassa, jota yrität avata makroja?
    Yritätkö avata Exceliä jostain toisesta ohjelmasta ilman koodia/koodilla?
    Mitä ohjelmia on auki?
    Käyttis?
    Office versio? yms
  17. taidankin avata uuden ketjun Niksinurkka...
    siinne sitten käyttäjien parhaat vinkit
  18. saahan sitä kysellä mitä huvittaa hämätäkseen, mutta ei se muutamaa sekuntia enempää hidastele alan ammattilaista, mutta kuten sanoin normikäyttäjät pysyy kurissa. ;-)
  19. VBA editoritn puolella valikosta Tools/ VBAProjectProperties... ja avautuvasta lomakkeesta Protection välilehti.
    Täppä kohtaan Lock Project for viewing ja halumasi salasana 2 kertaan ko. kohtiin. OK ja tallennus
    Nyt kun seuraavan kerran avaa työkirjan koodi on piilossa ja saa näkyville ainoastaan salasanalla. Ei pysty avaamaan makrojen valintaruudustakaan muokattavaksi, tosin näkyy siellä
    Toimii normikäyttäjälle suojauksena yes, mutta helposti saa kyllä koodit näkyville...
  20. todennäköisesti datarekisterissä vika- poista rekisteristä ja kun seuraavan kerran avaat Wordin se automaattisesti tekee uudet rekisteritiedot

    tarkemmat ohjeet tosta kohdasta Wordin Data-rekisteriavaimen poistaminen

    http://support.microsoft.com/kb/921541
    21. 31 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt