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. pari tapaa...

    hard codella...

    Sub Siirrä()
    Range("A1,A3,A5").Copy Worksheets("Sheet2").Range("IV1").End(xlToLeft)(1, 2)
    Range("A1,A3,A5") = ""
    End Sub

    valitset solut hiirellä ...

    Sub Siirrä2()
    Selection.Copy Worksheets("Sheet2").Range("IV1").End(xlToLeft)(1, 2)
    Selection = ""
    Range("A1").Select
    End Sub
  2. solumuotoiluksi
    kokonaisluvuille 0;-0;;@
    2 desimaalia esim. hinnoille 0,00;-0,00;;@
  3. neuvotaas välillä vähemmän käytettyä NIMI muutujaa.
    Eli lisätään nimi Tuote, jota voidaan sitten käyttää kaavoissa. Nimen käytön etuna mm. ettei tarvitse suojata soluja ja sen voi piilottaa käytäjältä ja siihen voi liittää kaavoja ja kaavoista tulee paljon selkokielisempiä lukea yms. Nyt kuitenkin jätin sen näkyville nimilistassa.

    eli solussa käytät vain nimeä esim. = tuote*1,22 +30
    tai esim ALV hinnan saat suoraan tekemällä nimen Loppuhinta ja viittaukseen laitat =tuote*1,22 ja sitten solussa kaavana =Loppuhinta joka vastaa siis kaavaa = tuote*1,22
    ...

    kaikki muuten kuin kuten Paavali neuvoi (kelpoisuusehto), ja se solumuotoilukin toimii ihan OK, koska siinä on piilotettuna kaikki muut paitsi teksti, joka korvataan" valitse tästä" tekstillä

    TAULUKON moduuliin...

    eli jos solun B2 teksti muuttuu, niin muuttaa Tuotteen hintaa solutekstin mukaisesti. Muuta tuotenimet sopivksi ja lisää tarvittaessa ja muuta tuotenimet hinnat sopivaksi. Muista jos lisäät tuotteita koodiin niin lisää myös kelpoisuusehto luetteloon kanssa
    jos haluat useampaan soluun tuotteita kopioi koodi ja muuta soluosoite (B2) ja muuta nimi muuttujan nimi esim. tuote1 jne

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B2")) Is Nothing Then
    Select Case Target
    Case "Tuoli"
    ActiveWorkbook.Names.Add Name:="Tuote", RefersToR1C1:="=30"
    Case "Pöytä"
    ActiveWorkbook.Names.Add Name:="Tuote", RefersToR1C1:="=130"
    Case "Penkki"
    ActiveWorkbook.Names.Add Name:="Tuote", RefersToR1C1:="=80"
    Case "Kaappi"
    ActiveWorkbook.Names.Add Name:="Tuote", RefersToR1C1:="=400"
    Case "Sänky"
    ActiveWorkbook.Names.Add Name:="Tuote", RefersToR1C1:="=800"
    End Select
    End If
    End Sub
  4. With ActiveCell
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:="=IF(RC[-2]=TODAY();1;0)"
    .FormatConditions(1).Interior.ColorIndex = 3
    End With
  5. ei tietoa onko sarakkeet peräkkäin vaiko siellä täällä ja mihin kopioidaan
    mutta tällä alkuun...
    muuttele kohdesarake sopivaksi, nyt A sarake ja alkaa A1.
    Toimii siten, että maalaat kopioitavan alueen ja kopioi tiedot alkaen A1

    moduuliin...

    Sub YhteenSarakkeeseen()
    Dim Alue As Range
    Dim Sarake As Integer
    On Error GoTo virhe
    Set Alue = Application.Intersect(Selection, ActiveSheet.UsedRange)
    Range("A:A") = ""
    For Sarake = 1 To Alue.Columns.Count
    If Sarake = 1 Then
    Alue.Range(Cells(1, Sarake), Cells(Alue.Rows.Count, Sarake)).Copy Range("A1")
    Else
    Alue.Range(Cells(1, Sarake), Cells(Alue.Rows.Count, Sarake)).Copy Range("A65536").End(xlUp).Offset(1, 0)
    End If
    Next Sarake
    poistu:
    Exit Sub
    virhe:
    MsgBox "et valinnut sarakkeita!"
    GoTo poistu
    End Sub
  6. siirrettävät tiedot esim C-sarakkeessa C1:C10 ja haluat ne taulukko2:een aina seuraavaan uuteen sarakkeeseen alkaen esim C1 ja sitten nollataan taulukko1:stä alue C1:C10 ?
  7. liitä koodi nappiin

    Private Sub CommandButton1_Click()
    Range("A1:E10").Copy Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
    End Sub
  8. mutta vaikea antaa ohjetta noin ylimalkaiseen kyssäriin
    Keep Excelling
    @Kunde
  9. käsitteet hiukan hukassa.
    Työkirjan sisällä ei voi avata tai sulkea taulukoita ("välilehtiä")- vain aktivoida
    mutta mai pen rai...
    napin koodi...
    Private Sub CommandButton1_Click()
    Worksheets("Taul1").Activate
    End Sub

    Private Sub CommandButton2_Click()
    Worksheets("Taul2").Activate
    End Sub
  10. Private Sub CommandButton1_Click()
    Range("A1") = Range("A1") +1
    End Sub
  11. Private Sub CommandButton2_Click()
    Dim Löydetty As Range
    Dim Löydetty2 As Range
    Dim Löydetty3 As Range
    On Error GoTo virhe
    Set Löydetty = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet2").EntireRow
    Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
    Set Löydetty2 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet3").EntireRow
    Union(Löydetty2, Löydetty2).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
    Set Löydetty3 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet4").EntireRow
    Union(Löydetty3, Löydetty3).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
    Worksheets("Sheet1").Activate
    Range("A1").Select
    Exit Sub
    virhe:
    MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
    Worksheets("Sheet1").Activate
    Range("A1").Select
    End Sub

    Function EtsiJaSiirrä(Hakuehto As Variant, Taulukko As String) As Range
    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets(Taulukko).Activate
    With Range("A:A")
    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
  12. riippuu miten haluat automatisoida
    esim. seuraavilla tapahtumilla
    kun avaat työkirjan
    kun suljet työkirjan
    kun tallennat työkirjan
    kun tulostat työkirjan
    kun solussa oleva tieto muuttuu esim.asiakas
    tuplaklikkaamalla taulukossa
    hiiren oikealla klikkaamalla taulukossa
    napilla

    eiköhän tossa ollut tarpeeksi vaihtoehtoja ja sitten vaan tapahtumaan koodi esim
    Sub Auto_Open()
    Range("A1") = Range("A1") +1
    End Sub
  13. liitä makro moduuliin ja tee nappi joko
    Kontrolli työkaluilla ja tuplaklikkaat nappia, jolloin koodisivu aukeaa ja lisäät makron nimen rivien väliin esim.

    Private Sub CommandButton1_Click()
    Testi
    End Sub

    tai jos teit sen Lomake työkaluilla niin liität Testi makron nappiin

    Klara Vappen!
    Keep Excelling
    @Kunde
  14. ja toiveesi toteutui...
    muuta sopivaksi...

    Function EtsiJaSiirrä(Hakuehto As Variant, Taulukko As String) As Range
    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets(Taulukko).Activate
    With Range("A:A")
    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 Testi()
    Dim Löydetty As Range
    Dim Löydetty2 As Range
    Dim Löydetty3 As Range
    On Error GoTo virhe
    Set Löydetty = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet2").EntireRow
    Union(Löydetty, Löydetty).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
    Set Löydetty2 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet3").EntireRow
    Union(Löydetty2, Löydetty2).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
    Set Löydetty3 = EtsiJaSiirrä(Range("Sheet1!A1"), "Sheet4").EntireRow
    Union(Löydetty3, Löydetty3).Copy Range("Sheet1!A65536").End(xlUp).Offset(1, 0).EntireRow
    Worksheets("Sheet1").Activate
    Range("A1").Select
    Exit Sub
    virhe:
    MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
    Worksheets("Sheet1").Activate
    Range("A1").Select
    End Sub
  15. lisäämällä toisen haun ja muuttelemalla solualueita toimiva versio...
    http://keskustelu.suomi24.fi/node/6001900#comment-31562054
  16. Sub LAske()
    Range("N2").Formula = "=IF(ISERROR(SUM(H2/C2*188)),"""",SUM(H2/C2*188))"
    Range("N2").AutoFill Destination:=Range("N2:N13"), Type:=xlFillDefault
    End Sub
  17. haku toimii joko täydellisenä tai osittaisena- eli jos haetaan jukkaa niin tulos voi olla täsmähaulla jukka tai osittaisena sitten vaikkapa jukka k.
    Molemmissa on ongelmana se, että jos haun tuloksena tulee useampi tulos niin mitä niistä käytetaan???
    oletetaan lisää
    taulukossa 2 on vain uniikkia nimiä, mutta taulukossa 1 voi olla tuplia tai erilailla kirjoitettuja esim. taul1 on jukka k., mutta taulukossa 2 onkin vain jukka. Tätätkö tarkoitit?
    voisit antaa esim. tiedoista ja tarkentaa mitä haluat...
  18. 1. Miten nimet ja arvot on listattu. A sarakkeessa nimi ja B sarakkeessa vastaavasti luvut -vai?
    2. Taulukossa 2 on siis kaikki nimet, mutta uupuu nimeä vastaavia lukuja?
  19. ennenkuin koodin väsään, niin pari kyssäriä, ettei tartte turhaa työtä tehdä...
    1. kuinka moneen taulukkoon tietoa siirretään?
    2. voiko siirtää koko rivin, vai pitääkö olla A-AX ?
    3. jos muuttuja muuttuu esim 2--->3 , niin poistetaanko taulukosta 2 tieto vai jääkö se sinne?

    muuten on ihan piece of cake....
  20. Excelin puolella siis taulukkonäkymässä ALT+F11 näppäinyhdistelmä avaa VBA editorin ja sieltä valitset valikosta INSERT/MODULE ja aukeavaan ikkunaan ((oletuksena Module1) kopioit koodin. Sitten vain suoritat ko proseduurin.
    vaihtoehtoisesti valikon File/Tiedosto vasemmalla puolella olevaa excel kuvaketta klikkaamalla hiiren oikealla ja valitsemalla View Code/ Näytä koodi aukeaa VBA editori ja sitten samat jutut kuin edellisessäkin
    21. 45 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt