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. moduuliin

    Sub Kopioi()
    On Error Resume Next
    Dim vika As Integer
    Dim x As Integer
    Sheets("Taul1").Activate
    Sheets("Taul2").Range("A:B") = ""
    Range("Taul2!A2") = "Otsikko1"
    vika = Range("A65536").End(xlUp).Row
    For Each solu In Range("A2:B" & vika)
    solu.Copy Destination:=Range("Taul2!B65536").End(xlUp).Offset(1, 0)
    x = x + 1
    If x Mod 2 = 0 Then
    Range("Taul2!A65536").End(xlUp).Offset(1, 0) = "Otsikko1"
    Else
    Range("Taul2!A65536").End(xlUp).Offset(1, 0) = "Otsikko2"
    End If
    Next
    Range("Taul2!A65536").End(xlUp) = ""
    Rows("1:1").Delete
    'vika = Range("Taul2!A65536").End(xlUp).Row
    'ActiveSheet.PageSetup.PrintArea = "$A$1:$B$" & vika
    End Sub
  2. kumpaako inputboxia käytät
    esim.
    Sub koe()
    x = InputBox("Anna luku")
    If x = "" Then
    MsgBox "Peruutit toiminnan", vbInformation
    End If
    x = Application.InputBox("Anna luku")

    If x = False Then
    MsgBox "Peruutit toiminnan", vbInformation
    End If

    End Sub
  3. mutta luepas vaikka tuolta hyvät ohjeistukset. en jaksa itse nyt kirjoitella
    eli ratkaisu on OFFSET eli SIIRTYMÄ

    http://www.tushar-mehta.com/excel/newsgroups/dynamic_charts/index.html#BasicRange
  4. kun ei ole milloin muuttujaa määritelty oikein- eli toimii vain kerran

    tossa minuutin ajolle makro

    Public milloin As Double
    Public Loppu As Double
    Sub aja()
    Loppu = Now + TimeSerial(0, 1, 0)
    Luku
    End Sub
    Sub Luku()
    Range("A1").Value = Rnd(1) * 1500
    milloin = Now + TimeValue("00:00:01")
    Application.OnTime milloin, "luku", Loppu
    End Sub
  5. tee lomakkeelle tekstiruutu ja komentopainike oletusnimillä

    pituus - Len(TextBox1.Text)
    ja valitsee koko tekstin ja muuttamalla esim. TextBox1.SelStart=2
    TextBox1.SelLength=2
    tekstistä merkit 3-4

    Private Sub CommandButton1_Click()
    TextBox1.SetFocus
    TextBox1.SelStart = 0
    TextBox1.SelLength = Len(TextBox1.Text)
    End Sub

    vastaavasti solusta - Len(Range("A1"))

    sub Koe()
    MsgBox Len(Range("A1"))
    End sub
  6. laita solumuotoiluksi oma "0"0
  7. kopioi nyt aina seuraavaan taulukkoon edellisen taulukon tiedot

    Sub Workbook_Open()
    Application.OnKey "{PGDN}", "Seuraava"
    End Sub

    Sub Workbook_Close()
    Application.OnKey "{PGDN}"
    End Sub

    Sub Seuraava()
    On Error Resume Next
    Range("A1:C2").Copy Destination:=Sheets(ActiveSheet.Index + 1).Range("A1")
    Sheets(ActiveSheet.Index + 1).Range("A2") = Sheets(ActiveSheet.Index + 1).Range("A2") + 1
    End Sub
  8. referensseistä
    Mulla näkyi olevan
    SCRRUN:DLL ja se löytyy mulla C:\WINDOWS\system32 kansiosta
  9. Auto_Open()
    teet omat valikot
    Auto_Close()
    palautat valikot
  10. Sub Vika()
    Range("A65536").End(xlUp).End(xlToRight).Select ' vika tietoa sisältävä rivillä
    'Range("A65536").End(xlUp).End(xlToRight).Offset(0, 1).Select' eka tyhjä rivillä
    End Sub
  11. moduuliin...

    Sub LajitteleSarakkeittain(Taulukko As String, Alue As String)
    Dim Sarakkeet As Integer
    Dim Rivit As Integer
    Dim Solujenlkm As Integer
    Dim s As Integer
    Dim r As Integer
    Dim laskuri As Integer
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("Huuhaa").Delete
    Worksheets.Add().Name = "Huuhaa"
    Worksheets("Huuhaa").Activate
    range("A1") = "luvut"
    For Each solu In range(Taulukko & "!" & Alue)
    range("A65536").End(xlUp).Offset(1, 0) = solu.Value
    Next solu
    range("A1", range("A1").End(xlDown)).Sort Key1:=range("A2"), _
    Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Sheets(Taulukko).Activate
    range(Alue).Cells(1, 1).Activate
    Sarakkeet = range(Alue).Columns.Count
    Rivit = range(Alue).Rows.Count
    Solujenlkm = range(Alue).Cells.Count
    laskuri = 2
    For s = 1 To Sarakkeet
    For r = 1 To Rivit
    range(ActiveCell.Address).Offset(r - 1, s - 1).Value = _
    range("Huuhaa!A" & laskuri).Value
    laskuri = laskuri + 1
    Next r
    Next s
    Sheets("Huuhaa").Delete
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    End Sub
    Sub koe()
    LajitteleSarakkeittain "Taul1", "A1:H10"
    End Sub
  12. eikös se tuolta käsin toimi kaikissa työkirjoissa. Eli tallenna Taulukot.xls sinne
  13. moduuliin... ja viittaus Microsoft Scripting Runtime kirjastoon
    voit hakea muitakin tietoja lisäämällä
    Range("A" & rivi) = Tiedosto.(ja valikosta lisää)

    Sub Testi()
    Columns("A:E") = ""
    Range("A1").Formula = "Tiedoston nimi:"
    Range("B1").Formula = "Tiedoston koko kt:"
    Range("C1").Formula = "Tiedoston tyyppi:"
    Range("D1").Formula = "Luotu pvm:"
    Range("E1").Formula = "Muokattu viimeksi pvm:"
    Range("A1:E1").Font.Bold = True
    Listaa "C:\Testikansio"
    End Sub

    Sub Listaa(LähdeKansionNimi As String)
    Dim FSO As Scripting.FileSystemObject
    Dim LähdeKansio As Scripting.Folder
    Dim Tiedosto As Scripting.File
    Dim rivi As Long
    Set FSO = New Scripting.FileSystemObject
    Set LähdeKansio = FSO.GetFolder(LähdeKansionNimi)
    rivi = Range("A65536").End(xlUp).Row + 1
    For Each Tiedosto In LähdeKansio.Files
    Range("A" & rivi) = Tiedosto.Name
    Range("B" & rivi) = Tiedosto.Size
    Range("C" & rivi) = Tiedosto.Type
    Range("D" & rivi) = Tiedosto.DateCreated
    Range("E" & rivi) = Tiedosto.DateLastModified
    rivi = rivi + 1
    Next Tiedosto
    Columns("A:E").AutoFit
    Set Tiedosto = Nothing
    Set LähdeKansio = Nothing
    Set FSO = Nothing
    End Sub
  14. funktiohan palauttaa arvon, jota voi käyttää vertailuissa yms.
    lisäämällä funktioon palautustyypin se on käytännöllinen esim. tyyliin

    Public Function testi(taulukko As String, mm As Integer) As Double

    Dim P As Double, L As Double

    P = Application.WorksheetFunction.VLookup(mm, Workbooks("TestiWb").Sheets(taulukko).Range("b2:j11"), 2)
    L = Application.WorksheetFunction.VLookup(mm, Workbooks("TestiWb").Sheets(taulukko).Range("b2:j11"), 3)

    testi = P + L * mm

    End Function
  15. aika pitkällehän oletkin päässyt :-)
    taulukon moduuleitahan ei voi poistaa, joten on poistettava sisältö...

    ennen tallennusta aja seuraava makro
    vaatii referenssin Visual Basic Extensibility ja makrojen suojauksessa täpän kohtaan luota Visual Basic projekteihin luotettavat lähteet välilehdellä.

    Sub PoistaKoodit(Työkirja As Workbook, ModuulinNimi As String)
    On Error Resume Next
    With Työkirja.VBProject.VBComponents(ModuulinNimi).CodeModule
    .DeleteLines 1, .CountOfLines
    End With
    On Error GoTo 0
    End Sub

    Sub Testi()
    PoistaKoodit ActiveWorkbook, "Taul1"
    'suorita tarvittaessa muillekin taulukoille
    'PoistaKoodit ActiveWorkbook, "Taul2"
    'PoistaKoodit ActiveWorkbook, "Taul3"
    End Sub
  16. ei ole helppoa tehdä ilman VBA:ta, mutta jos kerrot minkälaista kaavaa olet vailla niin yritän vääntää sellaisen ilman VBa:ta... Ei taida onnistua joka kaavalle
  17. ulkomuistista... VbLeft en ole varma miten se kirjoitetaan mutta ainakin {F1} on oikea muoto...

    Sub Auto_Open()
    Application.OnKey "{VbLeft}", "Vasemmalle"
    Application.OnKey "{VbRight}", "Oikealle"
    End Sub

    Sub Auto_Close()
    Application.OnKey "{VbLeft}"
    Application.OnKey "{VbRight}"
    End Sub
  18. lisasitko kaavion olemassaolevaan taulukkoon vaiko lisasitko sen uuteena taulukkona, jolloin siita tulee kaavion niminen taulukko. Tota jalkimmaista ajattelin lahinna...
  19. että allaolevat makrot eivat toimi oikein. Ei ole excelia tässä hotellin koneessa, mutta entapa jos tyokirja sisaltaa kaavioita :-)ja kumpikaan ei kasitellyt viimeista taulukkoa ekaa tosin kyllakin...
    palaan parin pv paasta asiaan, jos muut ei ole korjannneet tai olin vaarassa
    Keep exceling
  20. taulukon nimilehtien vasemmalla puolella on taulukoiden valintanuolinäppäimiä. Klikkaa hiiren oikealla ja valitse haluamasi taulukko...
    Keep Exceling ;-)
    21. 64 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt