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. mutta VBA ja Kunde jeesaa... ;-)

    taulukon moduuliin...

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    If InStr(1, Target, ",") > 0 Then
    Target.NumberFormat = "0.0"
    Else
    Target.NumberFormat = "0"
    End If
    Application.EnableEvents = True
    End Sub

    Keep EXCELing
    @Kunde
  2. piti olla
    vika=Range("O65536").End(xlUp).Row
  3. vika=Range("A65536").End(xlUp).Row

    ActiveChart.SeriesCollection(1).Values =Worksheets("Raportti_APU'").Range("O6:O"& vika)
    `
    Keep EXCELing
    @Kunde
  4. jos esim. A-sarakkeessa tietoja, niin hakee vikan solun alhaalta ylöspäin, eli voi olla välissä tyhjiäkin arvoja
    vika=Range("A65536").End(xlUp).Row
    ja tietoalue silloin esim. Range("A100:A" & vika)

    vastaavasti ylhäältä päin (stoppaa ekaan tyhjään ruutuun, eli ei voi olla tyhjiä välissä...)

    vika=Range("A1").End(xlDown).Row
    ja tietoalue silloin esim. Range("A100:A" & vika)

    Keep EXCELing
    @Kunde
  5. pystyy VBA:lla...

    ilmeisesti kysyjä haluaa riveillä olevat arvot lajiteltavan dynaamisesti?
  6. Sub poistaRivit()
    On Error Resume Next
    Rows(Range("B8") & ":" & Range("B9")).Delete
    End Sub


    Keep EXCELing
    @Kunde
  7. vaatii VBA koodin...
    haulla löytyy mun tekemiä makroja tästä foorumista
  8. Sub Järjestä()
    Dim alue As Range
    Dim solu As Range
    Dim EiTuplat As New Collection
    Dim i As Integer
    On Error Resume Next
    Range("A:A") = ""
    Set alue = Union(Range("B1", Range("B1").End(xlDown)), Range("C1", Range("C1").End(xlDown)), Range("D1", Range("D1").End(xlDown)))
    For Each solu In alue
    EiTuplat.Add solu.Value, CStr(solu.Value)
    Next
    On Error GoTo 0
    For i = 1 To EiTuplat.Count
    Cells(i, 1) = EiTuplat(i)
    Next
    Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending
    End Sub

    Keep EXCELing
    @Kunde
  9. tee lista perustuen 2 edelliselle valinnalle esim. ltk1_koivu ltk2_koivu ;-)
  10. http://www.contextures.com/xlDataVal02.html

    ton linkin ohjeilla tein 5 alavalikkoa nimeämällä vain ehtoalueet ja epäsuoraa funktiota alaotsikoissa käyttäen...

    lipasto -materiaali-vedin-vetimenkoko-vetimenväri...

    Keep EXCELing
    @Kunde
  11. Alkuperäinen pätkä:
    Lista = Sheets("Sheet1").Range("B50", Sheets("Sheet1").Range("B60").End(xlUp))

    ..listaa vain rivit B49:B50, eli yhtä riviä liian ylhäältä ja vain kaksi kohdetta.
    Käytössäni on Excel 2003 versio, olisiko sillä vaikutusta asiaan?

    EI
    Sheets("Sheet1").Range("B60").End(xlUp)
    ko. koodin pätkä valitsee solun B49 eli sinulla on solussa B49 joku arvo jolloin valinnaksi tulee koodissa Lista = Sheets("Sheet1").Range("B50", Sheets("Sheet1").Range("B60").End(xlUp)) B50:B49...

    eli muutat sitä arvoa B61 tai tarpeeksi kauaksi. Tietenkin jos sulla listat allekkain silloin ainut keino on hard codeta ne tyyliin Lista = Sheets("Sheet1").Range("B50:B60") kuten olet tehnyt


    no haasteeseen sitten...
    ei siinä tartte kummosta lisäystä

    Option Explicit
    Sub Täytä()
    Dim OLEobj As Object
    Dim Lista1 As Variant
    Dim Lista2 As Variant
    Dim Lista3 As Variant
    Lista1 = Sheets("Sheet1").Range("B50", Sheets("Sheet1").Range("B600").End(xlUp))
    Lista2 = Sheets("Sheet1").Range("C50", Sheets("Sheet1").Range("C600").End(xlUp))
    Lista3 = Sheets("Sheet1").Range("D50", Sheets("Sheet1").Range("D600").End(xlUp))
    For Each OLEobj In ActiveSheet.OLEObjects
    If TypeName(OLEobj.Object) = "ComboBox" Then
    Select Case Mid(OLEobj.Name, 9)
    Case 1 To 10
    OLEobj.Object.List = Lista1
    Case 11 To 20
    OLEobj.Object.List = Lista2
    Case 21 To 30
    OLEobj.Object.List = Lista3
    End Select
    End If
    Next OLEobj
    End Sub


    keep EXCELing
    @Kunde
  12. vaihda taulukon nimi sopivaksi ja luetteloalue nyt A1:AXXXXXX
    Option Explicit
    Sub Täytä()
    Dim OLEobj As Object
    Dim Lista As Variant
    Lista = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A65536").End(xlUp))
    For Each OLEobj In ActiveSheet.OLEObjects
    If TypeName(OLEobj.Object) = "ComboBox" Then
    OLEobj.Object.List = Lista
    End If
    Next OLEobj
    End Sub

    Keep EXCELing
    @Kunde
  13. kokeiles näitä

    Sub Palauta()
    Worksheets("Sheet1").Activate' vaihda taulukon nimi
    Columns("C:C").Select ' sarake C tulee aktiiviseksi
    Selection.Copy ' tälle riville ei enää päästä

    End Sub

    Sub Palauta()
    ActiveSheet.Columns("C:C").Select ' sarake C tulee aktiiviseksi
    Selection.Copy ' tälle riville ei enää päästä

    End Sub

    Keep EXCELing
    @Kunde
  14. esim. noissa selkeet ohjeet...

    http://www.contextures.com/xlDataVal02.html
    http://www.myonlinetraininghub.com/excel-data-validation-with-dependent-lists

    Keep EXCELing
    @Kunde
  15. laita koodi näytille, niin helpottaa kummasti virheen arvuuttelua ;-)

    Keep EXCELing
    @Kunde
  16. yksinkertaisimmillaan näin ...

    etusivun nimi=Varasto
    omat myynnit nimi=Myynnit
    omat ostot nimi =Ostot

    Myynnit taulukot moduuliin...

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    With Worksheets("Varasto").Range(Target.Address)
    .Value = .Value - Target.Value
    End With
    End Sub

    Ostot taulukon moduuliin...

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    With Worksheets("Varasto").Range(Target.Address)
    .Value = .Value + Target.Value
    End With
    End Sub

    ei oo virhetarkasteluja ja syöttösolun tarkistuksia, mutta nehän on helppo lisätä....


    Keep EXCELing
    @Kunde
  17. =LEFT(A1;FIND(" ";A1;1))&MID(MID(MID(SUBSTITUTE(A1;" ";"^";2);1;256);FIND("^";SUBSTITUTE(A1;" ";"^";2));256);2;FIND(" ";MID(MID(SUBSTITUTE(A1;" ";"^";2);1;256);FIND("^";SUBSTITUTE(A1;" ";"^";2));256))-2)

    VBA:lla

    moduuliin...
    Function HaeSanat(Solu As Range, Sana1 As Integer, Sana2 As Integer, Erotin As String) As String
    Dim a
    a = Split(Solu, Erotin)
    HaeSanat = a(Sana1 - 1) & " " & a(Sana2 - 1)
    End Function

    ja soluun mihin haluat tuloksen kaava
    =HaeSanat(A1;1;3;" ")
    hakee nyt solusta A1 ekan ja kolmannen sanan erottimena välilyönti


    Keep EXCELing
    @Kunde
  18. tossapa vastaus kyssäreihin...

    Sub Suojaa()
    ' poistaa taulukon suojauksen salasanalla
    ActiveSheet.Unprotect "kunde"
    ' tsekkaa onko alue tyhjä
    If Application.WorksheetFunction.CountA(Range("A6:D6")) > 0 Then
    MsgBox "alueella on tietoa"

    Else
    MsgBox "alue on tyhjä"
    End If
    ' suojaa taulukon salasanalla
    ActiveSheet.Protect "kunde"
    End Sub

    Keep EXCELing
    @Kunde
  19. Kyssäri1

    moduuliin...

    Option Explicit

    Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range

    Dim solu As Range
    Dim EkaOsoite As String
    Worksheets("Sheet1").Activate
    With HakuAlue
    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ä2 = solu
    EkaOsoite = solu.Address
    Do
    Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
    Set solu = .FindNext(solu)
    Loop While Not solu Is Nothing And solu.Address EkaOsoite
    End If
    End With
    End Function

    Sub Testi2()
    Dim Löydetty As Range
    Dim solu As Range
    On Error GoTo virhe
    Set Löydetty = EtsiJaSiirrä(Range("A4"), Range("A7:A500"))
    Löydetty.EntireRow.Delete
    Exit Sub
    virhe:
    MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
    End Sub

    Kyssäri2

    =VLOOKUP(A6;INDIRECT("A9:A501");1;FALSE)
    =SUM(INDIRECT("C9:C501"))


    Keep EXCELing
    @Kunde
  20. ko. taulukon moduuliin(jompi kumpi ei molempia).,,,

    jos taulukko aktivoidaan niin silloin päiväys kirjoitetaan (ei päivity jos taulukko on aktiivinen ja tallennat sen ja avaat uudelleen huomenna niin sama päiväys(eli vaatii avauksessa jonkun tietyn sivun aktivoimisen aluksi(pääsivu)...)
    Private Sub Worksheet_Activate()
    Range("C1") = Date
    End Sub

    tai jos haluat, että kun muutoksia tehdään

    Private Sub Worksheet_Change(ByVal Target As Range)
    Range("C1") = Date
    End Sub


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