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. With ActiveCell
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:="=IF(RC[-2]=TODAY();1;0)"
    .FormatConditions(1).Interior.ColorIndex = 3
    End With
  2. 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
  3. 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 ?
  4. liitä koodi nappiin

    Private Sub CommandButton1_Click()
    Range("A1:E10").Copy Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
    End Sub
  5. mutta vaikea antaa ohjetta noin ylimalkaiseen kyssäriin
    Keep Excelling
    @Kunde
  6. 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
  7. Private Sub CommandButton1_Click()
    Range("A1") = Range("A1") +1
    End Sub
  8. 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
  9. 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
  10. 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
  11. 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
  12. lisäämällä toisen haun ja muuttelemalla solualueita toimiva versio...
    http://keskustelu.suomi24.fi/node/6001900#comment-31562054
  13. 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
  14. 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...
  15. 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?
  16. 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....
  17. 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
  18. taulukon moduuliin...
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Calculate
    End Sub

    normaali moduuliin...

    Function LaskeLihavoidut(Alue As Range) As Double
    Application.Volatile True
    For Each solu In Alue
    If (Application.WorksheetFunction.IsNumber(solu) = True And solu.Font.Bold = True) Then
    LaskeLihavoidut = LaskeLihavoidut + solu
    End If
    Next
    End Function

    ja soluun kaava esim. =LaskeLihavoidut(A1:A1000)

    Keep Excelling
    @Kunde
  19. moduuliin...
    muuta sarake sopivaksi. Nyt A-sarakkeesta haetaa tuplia

    Sub PoistaTuplat()
    Dim solu As Range
    Dim Vika As Double
    Dim i As Long
    Dim EiTupla As New Collection
    On Error GoTo virhe
    Vika = Range("A65536").End(xlUp).Row
    Range("A" & Vika).Select
    For i = Vika To 1 Step -1
    If Not IsEmpty(ActiveCell) Then
    EiTupla.Add ActiveCell.Value, CStr(ActiveCell.Value)
    If i = 1 Then Exit For
    ActiveCell.Offset(-1, 0).Select
    End If
    Next
    Exit Sub
    virhe:
    ActiveCell.EntireRow.Delete
    Resume Next
    End Sub

    Keep Excelling
    @Kunde
  20. Private Sub tuuli_Click()
    Cells(ActiveCell.Row, 20).Value = tuuli.List(tuuli.ListIndex, 1)
    Cells(ActiveCell.Row, 20).Select
    tuuli.ListIndex = -1
    End Sub

    koodissa siis käytetään Click tapahtumaa ja se siirtää valinnan Cells(ActiveCell.Row, 20) soluun. Sen jälkeen poistetaan kohdistus combosta siirtämäällä se soluun ja lopuksi poistetaan combosta valinta, eli näin saadan valinta aina toimimaan toisin kuin change tapahtumassa, missä ei siis tapahdu muutosta jos valitaan sama valinta uudestaan ...

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