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. lue vastaukseni tuolta
    http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000032552691
  2. helpointa lienee kopioida alue uuteen työkirjaan ja tallentaa se elikä allaoleva kysyy aluetta ja kirjoittaa solun B1 tekstin mukaan tiedoston esim. c:\hep\hep.txt


    Sub Tallenna()
    Dim Alue As Range
    Dim Polku As String
    On Error Resume Next
    Application.DisplayAlerts = False
    Polku = Range("B1")
    Set Alue = Application.InputBox(prompt:="Valitse sarakealue", Type:=8)
    Application.ScreenUpdating = False
    Alue.Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:=Polku, FileFormat:=xlTextMSDOS
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub
  3. vika on siinä kun rivejä poistetaan ne pitää poistaa alkaen lopustapäin.
    Olen aikaisemmin postannut FIND funktion joka palauttaa alueen ja on tässäkin tapauksessa parhain ja nopein vaihtoehto. Yleensä pitäisi pyrkiä käyttämään excelin omia funktioita. For next loopit ovat niitä "tehottomimpia", mutta toimivia kuitenkin. Kysyjän tapauksessa nopeus ei varmaankaan nöyttele suurtakaan osuutta. Tossa nyt kuitenkin FIND makro ja sillähän voit tehdä sen tallennuksenkin yhdellä koodirillä toiseen taulukkoon...

    Sub CommandButton1_Click()
    EtsiAlue("EPÄTOSI", Columns("C"), xlFormulas, xlWhole).EntireRow.Copy Range("Sheet2!C65536").End(xlUp).Offset(1, 0).EntireRow
    EtsiAlue("EPÄTOSI", Columns("C"), MatchCase:=True).EntireRow.Delete
    End Sub

    Function EtsiAlue(Haettava As Variant, _
    Hakualue As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Boolean) As Range


    Dim Alue As Range
    Dim Ekaosoite As String
    If IsMissing(LookIn) Then LookIn = xlValues
    If IsMissing(LookAt) Then LookAt = xlPart
    If IsMissing(MatchCase) Then MatchCase = False

    With Hakualue
    Set Alue = .Find( _
    What:=Haettava, _
    LookIn:=LookIn, _
    LookAt:=LookAt, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=MatchCase, _
    SearchFormat:=False)
    If Not Alue Is Nothing Then
    Set EtsiAlue = Alue
    Ekaosoite = Alue.Address
    Do
    Set EtsiAlue = Union(EtsiAlue, Alue)
    Set Alue = .FindNext(Alue)
    Loop While Not Alue Is Nothing And Alue.Address Ekaosoite
    End If
    End With
    End Function

    Keep Excelling @Kunde
  4. ei kyllä pitäisi noin tapahtua, mutta kokeiles tällä
    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    If Target = Range("A1") Then
    Range("B1") = Range("B1") + Range("A1")
    End If
    Application.EnableEvents = True
    End Sub

    jos haluat suoraan samaan soluun kumulatiivisen laskurin niin tolla tällä se onnistuuu

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Static Summa As Double
    On Error Resume Next
    Application.EnableEvents = False
    If Target.Address = "$B$1" Then 'solu B1
    Summa = Summa + Target.Value
    Target.Value = Summa
    End If
    Application.EnableEvents = True
    End Sub
  5. Taulukon moduuliin ja muuta solut sopiviksi

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = Range("A1") Then
    Range("B1") = Range("B1") + Range("A1")
    End If
    End Sub
  6. Jos ei tartte solusta lukea niin kayttokelpoisin tapa on kelpoisuusehdon sanomaruutu ja ruksi kun solu on valittuna kohtaan
  7. kirjoita sana soluun ja tuplaklikkaa solun oikean reunan pikkuneliötä...
  8. collectionilla menee aika kivasti...
    muokkaa taulukot ja muut itsellesi sopivaksi

    HAUSKAA JOULUA JA HYVÄÄ UUTTA VUOTTA PALSTALAISILLE!!!
    Keep Excelling @Kunde

    Sub Haeparit()

    Dim Alue As Variant
    Dim Rivit As Long
    Dim Sarakkeet As Long
    Dim Parikokoelma As New Collection
    Dim Jäsen As Long
    Dim Kuvaus As String
    Dim Määrät(10000, 4) As String
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim vika As Long
    On Error Resume Next

    Sheets("Taul1").Select ' muuta taulukon nimi
    vika = Range("A65536").End(xlUp).Row
    Alue = Range("A1:L" & vika) ' muuta alue

    Rivit = UBound(Alue, 1)
    Sarakkeet = UBound(Alue, 2)
    For i = 1 To Rivit
    For j = 1 To Sarakkeet - 1
    For k = j + 1 To Sarakkeet
    If Alue(i, j) < Alue(i, k) Then
    Kuvaus = Alue(i, j) & "." & Alue(i, k)
    Else
    Kuvaus = Alue(i, k) & "." & Alue(i, j)
    End If
    Parikokoelma.Add Parikokoelma.Count + 1, Kuvaus
    Jäsen = Parikokoelma(Kuvaus)
    If Määrät(Jäsen, 0) = "" Then
    Määrät(Jäsen, 0) = Kuvaus
    Määrät(Jäsen, 1) = Alue(i, j)
    Määrät(Jäsen, 2) = Alue(i, k)
    End If
    If Määrät(Jäsen, 3) = "" Then
    Määrät(Jäsen, 3) = "1"
    Else
    Määrät(Jäsen, 3) = CStr(CInt(Määrät(Jäsen, 3)) + 1)
    End If
    Next k
    Next j
    Next i
    Sheets("Taul2").Select 'muuta taulukon nimi
    Cells.Clear
    Cells(1, 1).Resize(Parikokoelma.Count, 4) = Määrät
    Range("A1") = "Numero1.Numero2"
    Range("B1") = "Numero1"
    Range("C1") = "Numero2"
    Range("D1") = "Esiintymät"
    Range("A1:D1").Font.Bold = True
    Columns("A:D").Sort Key1:=Range("D2"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Columns("A:D").EntireColumn.AutoFit
    Columns("A:A").Delete 'poistaa Numero1.Numero2 sarakkeen
    End Sub
  9. eikös se toimi muotoilullakin?
    maalaa alue ja laita solumuotoiluksi esim. -0 tai jos desimaaleja haluat -0,00 jne
  10. aikakysymykset ovat excelissä välillä "kinkkisiä", mutta koodaamalla se onnistuu ihan helposti.
    Ilman koodiakin onnistuu esim. seuraavasti
    soluun A1 solumuotoiluksi teksti ja syötetään 6 numeroinen aika 111207
    soluun mihin halutaan päiväys näytettäväsi solumuotoiluksi päivämäärä ja sieltä sopiva esitystapa. Solun kaavaksi =TEKSTI(A1;"00-00-00")+0
    nyt solun arvoa voi käyttää laskutoimituksissa.

    Keep Exceling
    @Kunde
  11. Lisää excelissä viittaus ohjelmaan ja tallena labelin tieto muutujaan ja sitten käyttelet muuttujaa ohjelmassasi...
  12. http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000019204656#22000000019204656
  13. http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000014646147#22000000014646147
  14. Ohjelmistona on Openoffice 2.3 ja sen exel sovellus...
  15. CTRL+F11 lukitsee kentän ja silloin se ei päivity avattaessa. CTRL+SHIFT+F11 poistaa lukituksen ja kenttä päivittyy avattaessa. F9 päivittää tarvittaessa kentän tälle päivälle, jos olet poistanut lukituksen.
  16. CTRL+SHIFT+F9 muuttaa kentän tekstiksi
  17. nauhoita makro ja liitä siihen näppäinkomento tai tee nappi ja liitä makro siihen...
    esim.makro

    Sub Päiväys()
    Selection.InsertDateTime DateTimeFormat:="d.M.yyyy"
    End Sub
  18. Sub Transponoi()
    Dim vika As Integer
    Dim solu As Range
    Worksheets("Taul2").Range("B:B") = ""
    Worksheets("Taul3").Range("B:B") = ""
    Worksheets("Taul4").Range("B:B") = ""
    vika = Range("Taul1!A65536").End(xlUp).Row
    For Each solu In Range("Taul1!A1:A" & vika)
    solu.Offset(0, 1).Resize(1, 11).Copy
    Select Case LCase(solu)
    Case "ympyrä"
    Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Case "neliö"
    Range("Taul3!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Case "kolmio"
    Range("Taul4!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Case Else
    End Select
    Next
    Application.CutCopyMode = False
    End Sub
  19. Sub Transponoi()
    Dim vika As Integer
    Dim solu As Range
    Worksheets("Taul2").Range("B:B") = ""
    vika = Range("Taul1!A65536").End(xlUp).Row
    For Each solu In Range("Taul1!A1:A" & vika)
    solu.Resize(1, 11).Copy
    Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Next
    Application.CutCopyMode = False
    End Sub

    keep Exceling ;-)
    @Kunde
  20. tuolta voit latailla apuohjelman, jolla tarkkuudet kohdallaan...
    http://xlprecision.precisioncalc.qarchive.org/
    21. 61 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt