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. jos olet valinnut hiirellä solualueen ja vapautat hiiren ja toteat, että alue on joko liian suuri tai pieni ja haluat muuttaa sen kokoa niin SHIFT pohjassa klikkaa hiirellä uusi toisen suorakulman nurkkasolu
    TAI
    näppäimellä F8 ja tilariville ilmestyy EXT valinta voit sitten muuttaa valinnan kokoa ja uudelleen painamalla poistut laajemmustilasta
  2. tavalliseen moduuliin VBA editorin puolella...

    palkka on 0€ - en oo töissä enkä eläkkeellä kunhan vaan vetelen lonkkaa tällähetkellä.
    Toki ohjelmointikeikkoja voin ottaa vastaan (kokemustahan mulla taitaa olla piisalle asti...)
  3. moduuliin...

    Option Explicit

    Function Pvmluvuksi(Solu As Range) As Double
    Pvmluvuksi = CDbl(Day(Solu) & Month(Solu) & Format(Solu, "yy"))
    End Function

    Sub koe()
    ActiveCell = Pvmluvuksi(ActiveCell)
    ActiveCell.NumberFormat = "General"
    End Sub

    2 tapaa käyttää , joko

    1. Aktivoi solu ja suorita makro Koe (tee nappi makrolle)

    2. Solu mihin haluat tuloksen kirjoita kaava esim arvo solusta C1 =Pvmluvuksi(C1)

    jos luvut esim tietyssä sarakkeessa, niin silloin voisi tehdä aluemakron ja ei tartteisi yksitellen napsutella


    Keep EXCELing
    @Kunde
  4. ฉันจะให้การฝึกอบรม EXCEL, แต่ฉันไม่ให้การศึกษาขั้นพื้นฐาน

    Keep EXCELing
    @Kunde
  5. moduuliin...

    Option Explicit
    Sub Järjestä()
    Dim vika As Long
    Dim i As Long
    vika = Range("A65536").End(xlUp).Row
    For i = vika To 2 Step -2
    Range("A" & i - 1) = Range("A" & i - 1) & " " & Range("A" & i)
    Range("A" & i).Delete
    Next
    End Sub


    Keep EXCELing
    @Kunde
  6. miksi kysyt uudelleen samaa kun toimivat vastauksetkin jo alet saanut...

    http://keskustelu.suomi24.fi/node/9888741
  7. =PROPER(RIGHT(A1;(LEN(A1)-(FIND(" ";A1))))&" "&LEFT(A1;(FIND(" ";A1)-1)))
  8. EI
  9. taulukon moduuliin...

    Option Explicit

    Private Sub Worksheet_Change(ByVal target As Range)
    Dim solu As Variant
    On Error Resume Next
    Application.EnableEvents = False
    solu = target

    If Not Intersect(target, Range("B1:E1")) Is Nothing Then
    Range("B1:E1") = ""
    Range("A1") = solu
    target = solu
    End If
    Application.EnableEvents = True
    End Sub

    Keep EXCELing
    Keep ARCHAing
    @Kunde
  10. ei päätä eikä häntää selityksessä...
  11. mallihan oli selkeä...
    transponoi koko taulukon

    moduuliin...

    Option Explicit

    Sub Transponoi()
    Dim i As Long
    Dim vikarivi As Long
    Dim vikasarake As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    vikarivi = Range("A65536").End(xlUp).Row
    vikasarake = Range("A1").End(xlToRight).Column
    For i = 1 To vikarivi
    Range("A" & i, Range("A" & i).Offset(0, vikasarake - 1)).Copy
    Range("A" & vikarivi + 1).Offset(0, i - 1).PasteSpecial xlValues, Transpose:=True
    Next i
    Rows("1:" & vikarivi).Delete
    Application.CutCopyMode = False
    Range("A1").Activate
    Application.ScreenUpdating = True
    End Sub

    Keep EXCELing
    @Kunde
  12. laita mulle email [email protected]

    alku ja lopputilanne eri taulukoihinsa
  13. moduuliin...

    Option Explicit
    Dim Alue As Range
    Dim a As Variant
    Sub Transponoi()
    Range("A8").Cut Range("H1")
    Set Alue = Range(Range("B8"), Range("B8").End(xlToRight))
    a = Range(Range("B8"), Range("B8").End(xlToRight)).Value
    Alue = ""
    Range("H2", Range("H2").Offset(Alue.Count - 1, 0)) = ""
    Range("H2:H" & Alue.Count + 1) = Application.WorksheetFunction.Transpose(a)
    Application.CutCopyMode = False
    End Sub
    Sub Transponoi2()
    Range("H1").Cut Range("A8")
    Set Alue = Range(Range("H2"), Range("H2").End(xlDown))
    a = Range(Range("H2"), Range("H2").End(xlDown)).Value
    Range("B8", Range("B8").Offset(0, Alue.Count - 1)) = ""
    Alue = ""
    Range("B8", Range("B8").Offset(0, Alue.Count - 1)) = Application.WorksheetFunction.Transpose(a)
    Application.CutCopyMode = False
    End Sub

    Keep EXCELing
    @Kunde
  14. jälkimmäistä kyssäriä en ymmärtänyt?

    muuta alue sopivaksi
    moduuliin...

    Option Explicit

    Sub PoistaTyhjätRivit()
    Dim Alue As Range
    Dim Rivi As Long
    Dim Sarake1 As Long
    Dim Sarake2 As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set Alue = Range("B8:M40")
    Sarake1 = Alue(1, 1).Column
    Sarake2 = Alue(1, 1).Offset(0, Alue.Columns.Count - 1).Column
    For Rivi = Alue(Alue.Count).Row To Alue.Cells(1, 1).Row Step -1
    If ALueTyhjä(Range(Cells(Rivi, Sarake1), Cells(Rivi, Sarake2))) Then
    Range("A" & Rivi).EntireRow.Hidden = True
    End If
    Next Rivi
    virhe:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    End Sub

    Function ALueTyhjä(Alue As Range) As Boolean
    ALueTyhjä = (WorksheetFunction.CountA(Alue) = 0)
    End Function
    Sub resetoi()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    End Sub

    Keep EXCELing
    @Kunde
  15. eipä näy kuvassa kuin taulukonvalitsin, joten vaikeata arvuutella...
  16. no korjattu nyt, mutta tekstistä en oo varma kun ei oo tietoa miten se on tiedostossa...
    mutta eipähän toi laske kuin lukuja nyt sitteen...
    Option Explicit
    Sub Keskiarvo()
    Dim Originaali As Range
    Dim vika As Long
    Dim i As Long
    Dim lkm As Long
    Dim solu As Range
    On Error Resume Next

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set Originaali = Columns("A:B")
    Worksheets("Uusi").Delete
    On Error GoTo 0
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Uusi"
    Originaali.Copy Range("A1")
    Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Rows("1:2").Insert
    vika = Range("A65536").End(xlUp).Row
    lkm = 1
    For i = vika To 3 Step -1
    If Format(Range("A" & i), "hh") = Format(Range("A" & i - 1), "hh") Then
    Range("A" & i).Offset(-1, 1) = Range("A" & i).Offset(-1, 1) + Range("A" & i).Offset(0, 1)
    Range("A" & i).Offset(-1, 2) = Range("A" & i - 1).Offset(-1, 2) + lkm + 1
    lkm = lkm + 1
    Range("A" & i).EntireRow.Delete
    Else
    If lkm = 1 Then
    Range("A" & i).Offset(-1, 1) = Range("A" & i).Offset(-1, 1) + Range("A" & i).Offset(0, 1)
    Range("A" & i).Offset(0, 2) = 1
    End If
    lkm = 1
    End If
    Next
    vika = Range("B65536").End(xlUp).Row
    For Each solu In Range("B3:B" & vika)
    If IsNumeric(solu) Then
    solu = solu / solu.Offset(0, 1)
    End If
    Next
    Range("A:A").NumberFormat = "dd/yy/mm hh"
    Range("B:B").NumberFormat = "0.00"
    Range("C:C").Delete
    Range("B2") = "Keskiarvo"
    ActiveCell.Columns("A:B").EntireColumn.EntireColumn.AutoFit

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub

    Keep EXCELing
    @Kunde
  17. VBA:lla
    nyt tarkistaa solua C1 lisää soluja tarvittaessa

    taulukon moduuliin...

    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    If Not Intersect(Target, Range("D1")) Is Nothing Then
    If InStr(1, Target, ".") > 0 Then
    Target = ""
    MsgBox "pistettä ei hyväkstytä desimaalierottimena!"
    Target.Select
    GoTo loppu
    Exit Sub
    End If
    If Target = "" Then
    Target = ""
    Else
    If InStr(1, Target, ",") > 0 Then
    Target = Format(Target, "0.00") & " kN/m²"
    Else
    Target = Format(Target, "0") & " kN/m²"
    End If
    End If
    End If
    loppu:
    Application.EnableEvents = True
    End Sub
    Keep EXCELing
    @Kunde
  18. ei taida onnistua suomiasetuksilla jos desimaalierotin on .
    mutta jos tulos tulee toisesta solusta niin
    soluun kaava =TRUNC(A1;2)&" kN/m²"

    AI on arvo solusta
    2 desimaalien määrä
  19. lisää uuden taulukon "Uusi" ja tekee siellä tarvittavat jutskat...

    moduuliin...

    Option Explicit
    Sub Keskiarvo()
    Dim Originaali As Range
    Dim vika As Long
    Dim i As Long
    Dim lkm As Long
    Dim solu As Range
    On Error Resume Next

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set Originaali = Columns("A:B")
    Worksheets("Uusi").Delete
    On Error GoTo 0
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Uusi"
    Originaali.Copy Range("A1")
    Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Rows("1:2").Insert
    vika = Range("A65536").End(xlUp).Row
    lkm = 2
    For i = vika To 3 Step -1
    If Format(Range("A" & i), "hh") = Format(Range("A" & i - 1), "hh") Then
    Range("A" & i).Offset(-1, 1) = Range("A" & i).Offset(-1, 1) + Range("A" & i).Offset(0, 1)
    Range("A" & i).Offset(-1, 2) = Range("A" & i - 1).Offset(-1, 2) + lkm
    lkm = lkm + 1
    Range("A" & i).EntireRow.Delete
    Else

    lkm = 2
    End If
    Next
    vika = Range("B65536").End(xlUp).Row
    For Each solu In Range("B3:B" & vika)
    solu = solu / solu.Offset(0, 1)
    Next
    Range("A:A").NumberFormat = "dd/yy/mm hh"
    Range("B:B").NumberFormat = "0.00"
    Range("C:C").Delete
    Range("B2") = "Keskiarvo"
    ActiveCell.Columns("A:B").EntireColumn.EntireColumn.AutoFit

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub

    Keep EXCELing
    @Kunde
  20. palkat alueella A2:A9
    ja kaava soluun matriisikaavana SHIFT+CTRL+ENTER
    {=AVERAGE(IF(A2:A90;A2:A9))}
    21. 29 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt