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. tottahan tohon voisi kaavoja väännellä tai VBA:lla koodin rustata, mutta laitankin iän ikuisen Excel 4 makron peliin... oletetaan, että 1. laskettavat solut A1 alaspäin. 2. B1 kaava =SUBSTITUTE(A1;"x";"*") ja vetämällä alaspäin niin pitkälle kun laskettavia soluja on 3.Aktivoi solu C1 ja INSERT/NAME/DEFINE ja laita nimeksi vaikka laskin ja viittaukseksi =EVALUATE($B1) ja OK. jos esim. solussa A1 4x3+6x5-(2*4) niin soluun B1 tulee 4*3+6*5-(2*4) ja C1 lasketaan tulokseksi 34 toimii normaaleilla laskutoimituksilla... keep excelling @Kunde
  2. no nyt sekin sitten lisätty koodiin... Sub lisää() Dim ws As Worksheet Dim OnJo As Boolean On Error Resume Next For Each ws In ActiveWorkbook.Worksheets If ws.Name = "Tulos" Then OnJo = True End If Next If Not OnJo Then Sheets.Add , After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "Tulos" End If Worksheets("Tulos").Activate Range("D5:E1000") = "" For Each ws In ActiveWorkbook.Worksheets If Not ws.Name = "Tulos" Then Range("D5").Select Do Until ActiveCell = "" ActiveCell.Offset(1, 0).Select Loop ActiveCell = ws.Name ActiveCell.Offset(0, 1) = ws.Range("C1") ActiveCell.Offset(0, 2) = ws.Range("C3") End If Next End Sub
  3. kuten sanoin helppo muokata sopivaksi... ja tiedot voi hakea kerralla... Sub lisää() Dim ws As Worksheet On Error Resume Next Worksheets("Tulos").Activate Range("D5:E1000") = "" For Each ws In ActiveWorkbook.Worksheets If Not ws.Name = "Tulos" Then Range("D5").Select Do Until ActiveCell = "" ActiveCell.Offset(1, 0).Select Loop ActiveCell = ws.Name ActiveCell.Offset(0, 1) = ws.Range("C1") ActiveCell.Offset(0, 2) = ws.Range("C3") End If Next End Sub
  4. lomaketta tarvita. Kontrolli liitetään taulukkoon ja koodi sille esim. Private Sub Calendar1_Click() ActiveCell = Calendar1.Value End Sub ja sitten vaan laskentaan vaikka solut A1-A3 ja solumuotoiluksi A1-A2 päiväys ja A3 yleinen ja A3 soluun kaava A2-A1. sitten vaan aktivoi solun ja valitsee kontrollista pvm
  5. Control Toolboxista kun selailet lisää kontrolleja, niin siellä on ohjelmoitava kalenterikomponentti (calendar control). Eikös vastaavaa OO:sta löydy? ;-)
  6. "Kuinka saisin viimeiselle välilehdelle taulukon, joka kerää kaikista välilehdistä (solusta C1) tuloksen ja listaa ne viimeiselle välilehdelle päällekkäin (sarakkeelle, niin että ensimmäinen tieto tulee D5, toinen tulee E5, kolmas F5 jne)" jos tieto sarakkeelle niin silloinhan se pitäs olla D5,D6 jne no nyt tein makron D sarakkeelle ja hakee sitten sen C2 tiedon E sarakkeeseen... helppohan tota on muokata moduuliin... Sub lisää() Dim ws As Worksheet On Error Resume Next Worksheets("Tulos").Activate Range("D5:E1000") = "" For Each ws In ActiveWorkbook.Worksheets If Not ws.Name = "Tulos" Then Range("D5").Select Do Until ActiveCell = "" ActiveCell.Offset(1, 0).Select Loop ActiveCell = ws.Name & ": " & ws.Range("C1") ActiveCell.Offset(0, 1) = ws.Name & ": " & ws.Range("D2") End If Next End Sub
  7. kopioi alla oleva leikepöydälle. =SUM(IF(LEN(A1:A1000);1/COUNTIF(A1:A1000;A1:A1000))) valitse esim. solu C1 ja liitä KAAVARIVILLE ja lopuksi CTRL+SHIFT+ENTER ja klikkaa esim solu C4 ja koodia pukkaa suraavasti Sub Macro1() Range("C1").Select Selection.FormulaArray = _ "=SUM(IF(LEN(RC[-2]:R[999]C[-2]),1/COUNTIF(RC[-2]:R[999]C[-2],RC[-2]:R[999]C[-2])))" Range("C4").Select End Sub HUOMAA: KAAVA ON KIRJOITETTAVA VBA PUOLELLA SUHTEELLISENA VIITTAUKSENA ELI RC MUODOSSA VINKKI: tosta makron koodista voit melkein aina siivota noi .Select/Selection. jutut pois eli vastaava siistyttänä Range("C1").FormulaArray = _ "=SUM(IF(LEN(RC[-2]:R[999]C[-2]),1/COUNTIF(RC[-2]:R[999]C[-2],RC[-2]:R[999]C[-2])))"
  8. olisko se suomenkielisessä Tiedot/Lomake )versio 2003 se työkalu- ja ikkunavalikon välissä ja 3. ylhäältä avautuvassa valikossa. 2007 version ribboneista ei hajuakaan... tee nappi ja liitä koodi siihen oletuksena siis otsikot ekalla rivillä ja tiedot allekkain Sub koe() Range("A1").CurrentRegion.Select ActiveSheet.ShowDataForm End Sub
  9. kandeis testata tätä tee otsikkorivit ja maalaa alue ja sitten klikkaa valikosta DATA/FORM. Aukeavassa lomakkeessahan on hakukin valmiina. Ainut haitta on se, että joutuu päässälaskemaan uudet varastoarvot... Samantapaisen lomakkeehan sitä joutuis koodaamaan, mutta etuna siinä, että laskisi noi uudet varastoarvot automaattisesti.
  10. mutta pitää tietää kuinka monessa solussa on tietoa... sama vika tässäkin matriisikaavassa... eli ei saa olla tyhjiä soluja aluemäärityksessä =SUM(IF(FREQUENCY(MATCH(A1:A1000;A1:A1000;0);MATCH(A1:A1000;A1:A1000;0))>0;1)) mutta tällä toimii... syötä matriisikaavana CTRL+SHOFT+ENTER =SUM(IF(FREQUENCY(IF(LEN(A1:A1000)>0;MATCH(A1:A1000;A1:A1000;0);""); IF(LEN(A1:A1000)>0;MATCH(A1:A1000;A1:A1000;0);""))>0;1))
  11. kirjoita matriisikaavana CTRL+SHIFT+ENTER =SUM(IF(FREQUENCY(A:A;A:A)>0;1))
  12. ainut pelko on joskus vuosien perästä, kun vanha kone laukeaa ja on pakko ostaa uusi kone, niin saako silloin koneeseen enää asennettua esim. WIN XP ja jos ei, niin saako edes Office 2000 sitten enää asennettua uusiin käyttiksiin??? No ehkäpä se Kunde silloin jo pilvenreunalta kattelee noita juttuja ja naureskelee sen ajan Guruille... Keep Excelling @Kunde
  13. kerrankin joku puhuu asiaa... Itselläni pakon sanelemana versio 2003 ja sekin saa aikaan ongelmia vanhoille asiakkaille. Mitään mullistavaa ei ole tullut vs vanha/uusi normi käyttäjälle... Keep Excelling @Kunde Wappua
  14. korjattu viittaus BB työkirjaan Sub Kopioi() 'kopioi suljetusta työkirjasta aktiiviseen työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = Workbooks("BB") Set wb2 = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb2 Is Nothing Then On Error Resume Next wb.Activate For Each ws In ActiveWorkbook.Worksheets If ws.Visible Then ws.Select ws.Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next wb2.Close False Set wb2 = Nothing End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Kepp Excelling @Kunde
  15. Sub Kopioi() 'kopioi suljetusta työkirjasta aktiiviseen työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = ActiveWorkbook Set wb2 = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb2 Is Nothing Then On Error Resume Next For Each ws In wb.Worksheets If ws.Visible Then ws.Select Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next wb2.Close False Set wb2 = Nothing End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Sub Kopioi2() 'kopioi suljetusta työkirjasta suljettuun työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error GoTo 0 Set wb2 = Workbooks.Open("C:\AA.xls", True, True) If Not wb2 Is Nothing Then Set wb = Workbooks.Open("C:\BB.xls", True, False) If Not wb Is Nothing Then On Error Resume Next For Each ws In wb.Worksheets If ws.Visible Then ws.Select Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next End If End If wb2.Close False Set wb2 = Nothing wb.Close True Set wb = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
  16. vaihda polut oikeaksi ja jos haluat , että aktiivisesta työkirjasta tekee siirron suljettuina oleviin (AA.xls ja BB.xls) niin poista hipsut. Nyt kopioi suljetusta AA.xls aktiiviseen työkirjaan... Sub Kopioi() Dim wb As Workbook Dim ws As Worksheet On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb Is Nothing Then On Error Resume Next wb.Worksheets("Taul2").Range("D:F").Copy On Error GoTo 0 wb.Close False Set wb = Nothing 'Set wb = Workbooks.Open("C:\BB.xls", True, False) 'On Error GoTo 0 ' If Not wb Is Nothing Then On Error Resume Next For Each ws In Sheets If ws.Visible Then ws.Select (False) Next Range("D:F") = "" Range("D1").Select ActiveSheet.Paste Sheets(1).Select Range("D1").Select ' wb.Close True ' Set wb = Nothing ' ' End If End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Keep Excelling @Kunde
  17. jos olet tehnyt VBA:lla lomakkeen ja lomakkeella listbox, mutta taulukon puolella oikea koodi on Listbox1.ListFillRange= Worksheets("je").Range(Cells(5, 2), Cells(c, 19)).Address
  18. Sub LuuppiMakro() Dim i As Integer For i = 1 To Range("A1") Testi i Next End Sub Sub Testi(i As Integer) MsgBox i End Sub Keep Excelling
  19. laita Sheet2 ominaisuusikkunassa (VBA puolella) sen Visible arvoksi xlSheetVeryHidden ja poista makro...
  20. http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000031539082#22000000031539082 muuttele alue sopivaksi ja tuplat löytyy... triplalle koodaan -syssymmällä
    21. 52 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt