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. muotoile sopivaksi ...
    esim. nyt

    hakee Taul1 A -sarakkeesta solunjen E1 ja E2 väliset luvut TAul2 A-sarakkeeseen...

    aloitusehto solussa E1
    lopetusehto solussa E2

    Sub HakuEhdoilla()
    On Error Resume Next
    Dim Löydetty As Range
    Dim Löydetty2 As Range
    Dim solu As Range
    Dim vika As Long
    Set Löydetty = Etsi(Chr(126) & Range("E1"))
    Set Löydetty2 = Etsi(Chr(126) & Range("E2"))
    Range(Löydetty.Offset(1, 0).Address & ":" & Löydetty2.Address).Copy Worksheets("Taul2").Range("A65536").End(xlUp).Offset(1, 0)
    vika = Worksheets("Taul2").Range("A65536").End(xlUp).Row
    Worksheets("Taul2").Range("A" & vika) = Left(Worksheets("Taul2").Range("A" & vika), InStr(1, Worksheets("Taul2").Range("A" & vika), "~", 1) - 1)
    End Sub

    Function Etsi(Hakuehto As Variant) As Range
    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets("Taul1").Activate
    With Range("A:A")
    Set solu = .Find( _
    What:=Hakuehto, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False, _
    SearchFormat:=False)
    If Not solu Is Nothing Then
    Set Etsi = solu
    End If
    End With
    End Function

    Keep EXCELing
    @Kunde
  2. Viile Virtanen tyyliset ihan OK

    ongelmia, nimissähän voi olla väliviiva tai sitten ei ...
    Anna Kaisa Virtanen
    Anna-Kaisa Virtanen
    Anna Kaisa Virtanen Lahtinen
    Anna-Kaisa Virtanen Lahtinen
    Anna-Kaisa Virtanen-Lahtinen

    asiaa puitu aiemmin ainakin näissä ketjuissa, ja melkein toimivia ratkaisujakin löydetty...

    http://keskustelu.suomi24.fi/node/1645628#comment-8028249
    http://keskustelu.suomi24.fi/node/1466093#comment-7097195

    Keep EXCELing
    @Kunde
  3. Ei siihen mitään loppusummia pidä lisätä, se laskee ne automaattisesti...
    testasin tosin sen vain aloittamalla tyhjällä sarakkeella ja lisäämällä uuden rivin/rivejä ja ainakin oletukseni toimii niinkuin halusit....
    siis ei mitään omia kaavoja

    Keep EXCELing
    @Kunde
  4. painovirhepaholainen ;-)
    oikea koodi

    Dim vika As Long
    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Range("H:H, L:L, M:M").SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = xlNone
    vika = Range("F65536").End(xlUp).Row
    If vika = 1 Then
    Range("F" & vika + 1) = Application.WorksheetFunction.Sum(Range("F1:F1"))
    Else
    Range("F" & vika) = Application.WorksheetFunction.Sum(Range("F1:F" & vika - 1))
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub
    Sub reset()
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub
  5. Function kaavantulos(r As Range)
    f = r.Formula
    v = r.Value
    If (InStr(f, "=") = 1) Then
    kaavantulos = v
    Else
    kaavantulos = ""
    End If
    End Function

    turhaa testailua kun excelissä valmis funktio...

    sama

    Function kaavantulos2(r As Range)
    If r.HasFormula Then
    kaavantulos2 = r.Value
    Else
    kaavantulos2 = ""
    End If
    End Function

    Keep EXCELing
    @Kunde
  6. kopioi kaavasolut aktiivisesta taulukosta taulukko2 samoihin soluihin...

    Sub b()
    For Each solu In Cells.SpecialCells(xlCellTypeFormulas)
    solu.Copy
    Worksheets("Taul2").Range(solu.Address).PasteSpecial xlPasteValues
    Next
    Application.CutCopyMode = False
    End Sub


    Keep EXELing
    @Kunde
  7. Taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Range("H:H, L:L, M:M").SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = xlNone
    vika = Range("F65536").End(xlUp).Row
    If vika = 1 Then
    Range("F" & vika + 1) = Application.WorksheetFunction.Sum(Range("F1:F1"))
    Else
    Range("F" & vika) = Application.WorksheetFunction.Sum(Range("F1:F" & vika - 1))
    End If
    Range("F" & vika) = Application.WorksheetFunction.Sum(Range("F1:F" & vika - 1))
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub
    Sub reset()
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub


    Keep EXCELing
    @Kunde
  8. taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    Range("H:H, L:L, M:M").SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = xlNone
    End Sub

    toinen kyssäri:
    missä loppusumma?
  9. "Eli saako tuota automaattista solujen värjäytymistä jotenkin pois? Eli jos esim. solu H29 on vihreä, tulee sen alapuolella olevastakin H30 solusta vihreä mikäli lisään rivejä"

    Joopa joo
    ihan eri juttu...
    no katellaan kun keritään
  10. hehehe...
    ehkäpä Kundepuu (alias Kunde auttaa sua kaupallisesti -maybe too heavy to free)...
  11. kymmeniä mun tekemiä vastaavia koodin pätkiä löytyy haulla (ainut ero , että useimmat palauttaa koko rivin, mutta pikku rukkauksella palauttaa mitä tahansa ja mistä kohtaa tahansa... ;-)
  12. laita se suurimmalla numerolla oleva referenssi käyttöön.
    Joku referenssi siiinä koneessa on muuttunut. Jos referenssi puuttuu niin se herjaa puuttumista. Ehkäåä se koodi olisi parasta olla normaalimoduulissa eikä This Workbook moduulissa?
  13. TArgettia voit käyttää vain taulukon tapahtumakoodissa
    jos siirrät tietoa taulukosta toiseen niin esim.
    Range("Taul2!A2")= Ucase( Range("Taul1!A2"))
  14. Poista solulinkki ja kokeile

    Private Sub ComboBox1_Change()
    Range("B2") = ComboBox1.List(ComboBox1.ListIndex)
    End Sub
  15. Private Sub Worksheet_Change(ByVal Target As Range)
    Range("H:H").Interior.ColorIndex = xlNone
    Range("H9").Interior.ColorIndex = 56
    End Sub
  16. en nyt saa tota taul2 sarjaa täsmäämään...
    A200=1010
  17. pilkun jälkeen iso kirjain- harmaita hiuksia tuotti, mutta eiköhän toi nyt aika lähellä totuutta... -;)

    käytin tota WorksheetFunction.Trim(lause(i)) tossa, jotta se poistaa kaikki ylimääräisetkin välilyönnit lauseesta...

    Dim lause As Variant
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A11:A12")) Is Nothing Then
    Target = UCase(Target)
    End If
    If Not Intersect(Target, Range("A13: A14")) Is Nothing Then
    lause = Split(Target, ".")
    For i = 0 To UBound(lause)
    lause(i) = WorksheetFunction.Trim(lause(i))
    If Len(lause(i)) > 0 Then lause(i) = UCase(Left(lause(i), 1)) & Mid(lause(i), 2)
    Next
    Target = Join(lause, ". ")
    End If
    End Sub

    Keep EXCELing
    @Kunde
  18. tarpeet vaihtui toiseksi alkuperäisestä, mutta eipä murehdita sitä...

    moduuliin...
    Sub Auto_Open()
    Worksheets("Sheet1").Range("D6:L6").Interior.ColorIndex = 56
    End Sub

    ja kyseessäolevan TAULUKON MODUULIIN...

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("D6:L6").Interior.ColorIndex = 56
    End Sub

    Keep EXCELing
    @Kunde
  19. et ole määritellyt LN254 labelia, johon viittaat GoTo rivillä...

    On Error Resume Next
    If ActiveSheet.Range("B22") = "" Then
    GoTo LN254 'tästä hyppy
    On Error GoTo 0
    End If
    'koodia...
    LN254:
    ' tänne tullaan GoTo LN254 riviltä
    MsgBox "tänne tultiin!"
  20. Ookos koskaan kokeillut makronauhoitinta?
    Tommosta se aikaan...
    Sub Macro1()
    '
    ' Macro2 Macro
    ' Macro recorded 2.3.2011 by kunre
    '

    '
    Range("D6:L6").Select
    Selection.Interior.ColorIndex = 56
    End Sub

    toki sitä voi kaunistella ja poistella yleensä 80-90% turhaa skeidaa ja saada se helpommin luettavaksi ja paremmin toimivaksi...

    Sub Macro1()
    Range("D6:L6").Interior.ColorIndex = 56
    End Sub

    Keep EXCELing
    @Kunde
    21. 36 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt