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. Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+RangeDim+x'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'määritellään+tulostusalueActiveSheet.PageSetup.PrintArea+=+"$A$4:$F$100"'näytetään+tulostuksen+esikatseluActiveSheet.PrintPreviewx+=+MsgBox("Tulostetaanko?",+vbYesNo,+"Tulostus")If+x+=+6+Then++++'tulostetaan+sivu++++ActiveWindow.SelectedSheets.PrintOut++++Range("A130:A230").Delete++++Range("1:100").SpecialCells(xlCellTypeVisible).Copy+Range("A130")End+If'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep+EXCELing@Kunde
  2. Rivi+riviltä+koodinajoValitse+koodinsta+joku+ei+kommentti+rivi+ja+painele+F8++näppäintä+ja+koodia+suoritetaan+rivi+kerrallaan.+Voit+lisätä+stopin+koodiin+klikkaamalla+sitä+koodialueella+vasemmalla+olevaa+harmaata+palkkia++hiiren+vasemmalla+painikkeella.+Nyt+koodi+suoritetaan+siihen+stopiin+asti+ja+ja+jatketaan+F8+ivi+kerrallaan+tai+F5+loppuun+asti.Esikatselusta+poistut+ESC+tai+klikkaamalla+poistunappia.+Kysyy+sitten+haluatkotulostaa+jne...Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+Range'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'määritellään+tulostusalueActiveSheet.PageSetup.PrintArea+=+"$A$4:$F$100"'näytetään+tulostuksen+esikatseluActiveSheet.PrintPreviewx+=+MsgBox("Tulostetaanko?",+vbYesNo,+"Tulostus")If+x+=+6+Then++++'tulostetaan+sivu++++ActiveWindow.SelectedSheets.PrintOutEnd+If'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep+EXCELing@Kunde
  3. Resetointi+makro+on+siltä+varalle,+jos+koodia+askel+askeleelta+suoritat+ja++koko+makroa+ei+ajeta+loppuun+syystä+tai+toisesta+eli++toi+rivi+jää+suorimattamatta,++ei+Excelsitten++reagoitapahtumiin.+Siis+ihan+helpottamaan+elämää+toi+koodi...++;-)tossa+nyt+pyytämäsi+päivityksetPrivate+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+Range'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'määritellään+tulostusalueActiveSheet.PageSetup.PrintArea+=+"$A$4:$F$100"'tulostetaan+sivuActiveWindow.SelectedSheets.PrintOut'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep++EXCELing@Kunde
  4. mun+koodissa+piilota+rivit+8-+haluamasi+määrä++alaspäinsitten+liität+koodin+ko.taulukon+moduuliin+ja+alat+syöttelemään+tietoja+niin+poistaa+piilotuksen+aktiivinen+solu+2eli+kun+lisäät+tietoa+(muutat+solunarvoa)+6+rivillä+niin+8+rivi+tulee+näkyviin+ja+7+rivillä+sitten+9+rivi+tulee+näkyviin+jne...
  5. jos+antamasi+kaava+toimii+niin+kuten+sanoin+postauksessani+löydät+oikean+sarakkeen+ko+päivänäApplication.WorksheetFunction.Match(cdbl(Date),+Range("8:8"))...lisättynä+toimivaan++koodiisiPrivate+Sub+ToggleButton1_Click()On+Error+Resume+NextIf+ToggleButton1.Value+=+True+ThenActiveSheet.Range("$A$8:$CDZ$95").AutoFilter+Field:=Application.WorksheetFunction.Match(CDbl(Date),+Range("1:1")),+Criteria1:=RGB(255,+0+_,+0),+Operator:=xlFilterCellColorElseActiveSheet.Shapes.Range(Array("ToggleButton1")).SelectActiveSheet.Range("$A$8:$CDZ$95").AutoFilter+Field:=Application.WorksheetFunction.Match(CDbl(Date),+Range("1:1"))End+IfEnd+SubKeep++EXCEling@Kunde
  6. Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+Range'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'tulostetaan+sivu'ActiveWindow.SelectedSheets.PrintOut'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep+EXCEling@Kunde
  7. automaatisesti+löydät+sarakkeen+VBA:ssa+Application.WorksheetFunction.Match(cdbl(Date),+Range("8:8"))Keep++EXCEling@Kunde
  8. koodi+ThisWorkbook+moduuliin...Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+Range'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'tulostetaan+sivuActiveWindow.SelectedSheets.PrintOut'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep+EXCEling@Kunde
  9. ThsiWorkbook+moduuliin...Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)On+Error+Resume+NextApplication.EnableEvents+=+False'muuta+ehto+sopivaksiIf+ActiveSheet.Range("H1")+=+1+Then'muuta+rivit+sopivaksi++++Rows("6:9").EntireRow.Hidden+=+TrueActiveWindow.SelectedSheets.PrintOut++++Rows("6:9").EntireRow.Hidden+=+FalseCancel+=+TrueApplication.EnableEvents+=+TrueEnd+IfEnd+Sub
  10. ko.+taulukon+moduuliin....muuta+rivit+sopivaksiPrivate+Sub+Worksheet_Change(ByVal+Target+As+Range)On+Error+Resume+NextIf+Not+Intersect(Target,+Rows("6:20"))+Is+Nothing+Then++++Application.EnableEvents+=+False++++Target.Offset(2,+0).EntireRow.Hidden+=+False++++Application.EnableEvents+=+TrueEnd+IfEnd+SubKeep++EXCELing@Kunde
  11. Sub+Suojaa()Dim+i+As+LongFor+i+=+1+To+Sheets.CountSheets(i).ProtectNextEnd+SubSub+PoistaSuojaus()Dim+i+As+LongFor+i+=+1+To+Sheets.CountSheets(i).UnprotectNextEnd+SubKeep+EXCELing@Kunde
  12. Et+ole+ymmärtänyt+ohjeitani+oikein+ja+olet+sekoittanut+nyt+vanhaa+ja+uutta+koodia+keskenään...Väännetään+vielä+rautalangasta,+eli+hakuarvo+solussa+C2+ja+vaihteluväli+solussa+C1.+Hakualue+on+A24:D600+ja+haen+sarakkeesta+D+eli+arvolla+4,+tällöinEnsimmäinen+koodini+oli+oma+funktio+ja+jälkimmäinen+podtaamani+koodi+ei+ole+oma+funktio,+vaan+perustuu+solujen+muutokseen+taulukossa.+Eka+näkyi,+mutta+jälkimmäisen+ei+näy+funktiolistassa2+eri+versiota+versio1.MODUULIIN....Sub+OmaPHaku(Haku+As+Double,+Hakualue+As+Range,+Vaihteluväli+As+Double,+Sarake+As+Long)i+=+0ReDim+Tulos(0)'tulos+sarakkeeseen+LRange("B:B")+=+""For+Each+Solu+In+HakualueIf+Solu+>=+Haku+-+(Vaihteluväli+/+100)+*+Haku+And+Solu+<=+Haku+++(Vaihteluväli+/+100)+*+Haku+ThenTulos(i)+=+Solu.Offset(0,+Sarake+-+1)i+=+i+++1ReDim+Preserve+Tulos(i)End+IfNextRange("B1").Resize(UBound(Tulos)).Value+=+Application.WorksheetFunction.Transpose(Tulos)End+SubSEN+TAULUKON+MODUULIIN+MISSÄ+TIEDOT+ON++ESIM+TAUL1+MODUULIIN....Taul1+solut+ja+niiden+merkitys+on+alla+ja+jos+haluat+muuttaa+niin+muutat+koodissaesim.+soluissa+tekstit'C1+=+hakuarvo+=27,5'C2+=+vaihteluväli=10+hakualue+har+codattu+koodiin+samoin+kuin+sarakePrivate+Sub+Worksheet_Change(ByVal+Target+As+Range)Application.EnableEvents+=+FalseIf+Not+Intersect(Range("C1:C2"),+Target)+Is+Nothing+ThenOmaPHaku+Range("C1"),+Range("A24:D600"),+Range("C2"),+4End+IfApplication.EnableEvents+=+TrueEnd+Subversio+2+mitä+tarjosin+aluksi,+siinä+voi+hakualueen+ja+sarakkeen+kanssa+syöttää+soluihinMODUULIIN...Sub+OmaPHaku(Haku+As+Double,+Hakualue+As+String,+Vaihteluväli+As+Double,+Sarake+As+Long)i+=+0ReDim+Tulos(0)'tulos+sarakkeeseen+LRange("B:B")+=+""For+Each+Solu+In+Range(Hakualue)If+Solu+>=+Haku+-+(Vaihteluväli+/+100)+*+Haku+And+Solu+<=+Haku+++(Vaihteluväli+/+100)+*+Haku+ThenTulos(i)+=+Solu.Offset(0,+Sarake+-+1)i+=+i+++1ReDim+Preserve+Tulos(i)End+IfNextRange("B1").Resize(UBound(Tulos)).Value+=+Application.WorksheetFunction.Transpose(Tulos)End+SubSEN+TAULUKON+MODUULIIN+MISSÄ+TIEDOT+ON++ESIM+TAUL1+MODUULIIN....Taul1+solut+ja+niiden+merkitys+on+alla+ja+jos+haluat+muuttaa+niin+muutat+koodissaesim.+soluissa+tekstit'C1+=+hakuarvo+=27,5'C2+=+vaihteluväli=10'C3=+hakualue=A24:D600'C4=+sarake=4Private+Sub+Worksheet_Change(ByVal+Target+As+Range)On+Error+Resume+NextApplication.EnableEvents+=+FalseIf+Not+Intersect(Range("C1:C4"),+Target)+Is+Nothing+ThenOmaPHaku+Range("C1"),+Range("C3"),+Range("C2"),+Range("C4")End+IfApplication.EnableEvents+=+TrueEnd+SubKeep+EXCELing@Kunde
  13. jos+haluat+esim.+ruksin+tms+se+onnistuu+helposti.Tsekkaa+lisää+merkin+code+ja+fontti+ja+muuta+koodiineli+nyt+Wingdings+fontti+ja+ruksi+merkki+ja+alhaalta+luet+Char+code(vaihda+mistä+Symbol+dec)+eli+lissä+merkki+ja+sieltä+Wingdings+ja+sit+ohjeen+mukaan...koodissa+code(80)+vastaa+P-kirjainta+normaalitekstissä,+mutta+fontilla+Wingdings2+se+on+se+harakanvarvaseli+omassa+kaavassasi+pitää+vaihtaa+X+kirjain+P+kirjaimeksi...Keep+EXCELing@Kunde
  14. niin+ja+oisessa+koodin+pätkässä+siis++tulos+sarakkeeseen+Lmuuta+tarvittaessa'tulos+sarakkeeseen+LRange("L:L")+=+"".........Range("L1").Resize(UBound(Tulos)).Value+=+Application.WorksheetFunction.Transpose(Tulos)Keep++EXCELing@Kunde
  15. lisäsit+koodin+uuteen+moduuliin...ko+taulukon+moduuliin+tarkoittaa+sitä,++että+koodi+lisätään+sen+taulukon+moduuliin+missä+sen+halutaan+toimivan.+Toki+koodata+voisin+This+Workbookiin+kanssa,++mutta+sitten+pitää+tsekata+,+että++koodi+toimii+vaan+esim.+Taul1:ssä+eikä+muissa.++Mutta+kätevää+toisaalta,++jos+tarttee+useammassa+taulukossa+samaa+koodia....eli+jos+jutut+on+Taul1:ssä++niin++kopioi+alla+oleva+koodi+siis+sinnePrivate+Sub+Worksheet_Change(ByVal+Target+As+Range)If+Not+Intersect(Range("H1:K1"),+Target)+Is+Nothing+ThenOmaPHaku+Range("H1"),+Range("I1"),+Range("J1"),+Range("K1")End+IfEnd+SubTaul1+solut+ja+niiden+merkitys+on+alla+ja+jos+haluat+muuttaa++niin+muutat+koodissaesim.+soluissa+tekstit'H1+=+hakuarvo+=27,5'I1+=+hakualue+=B1:B100'J1+=vaihteluväli+=5'K1+=+palautettava+sarake+=2+eli+hakualueesta+seuraava+sarake+oikealle+tai+voi+hakea+vasemmallekin+0+on+eka+sarake+vasemmalle+jne.
  16. Solverilla+onnistuulaita+A+sarakkeeseen++maksetut+summat+esim+A1:A9vastaaviin++C+sarakkeen+soluihin++kaava+=A1*B1+ja+kopioi+kaavaa+vetämällä+alas+esim++soluun+C10+laita+kaava+=+SUMMA(C1:C9)avaa+solverilomakkeella+syötä+seuraavat+arvotSet+objective+=+C10value+of++kohtaan+täppä+ja+sille+maksettu+summaBy+changing+variable+cells++kohtaan+=+B1:B9vakioruutuun+klikkaa+lisää+ja+avautuvassa+lomakkeessa++cell+reference=+B1:B9+ja+viereisestä+valikosta+valitse+binMake+unconstrained+variables+non-negative+poista+siitä+täppäklikkaa+solveavautuvasta+valikosta+keep+solver+solution++ja+OKkeep++EXCELing@Kunde
  17. helpoin+ja+nopein+tapa+tehdä+oma+funktio...moduuliin...soluun+kaava+esim.++=OmaPHaku(G1;A1:A100;5;2),+missäG1=hakuarvoA1:A100=+hakualue+arvolle5=+vaihteluväli+arvolle++/-jos+eri++positiivisilla+ja+negatiivisella+,+niin+helppo+fiksata+kaavaan+tarvittaessa2=sarakehakuarvo+sarake+on+1,+joten+arvo+2+palauttaa+hakusarakkeen+oikeanpuolella+olevan+sarakkeen+arvot.+Vastaavasti+arvolla+0++palauttaisi+vasemmanpuoleisen+sarakkeen+arvotFunction+OmaPHaku(Haku+As+Double,+Hakualue+As+Range,+Vaihteluväli+As+Double,+Sarake+As+Long)Dim+Solu+As+RangeDim+Tulos+As+StringxResult+=+""For+Each+Solu+In+Hakualue++++If+Solu+>=+Haku+-+(Vaihteluväli+/+100)+*+Haku+And+Solu+<=+Haku+++(Vaihteluväli+/+100)+*+Haku+Then++++++++Tulos+=+Tulos+&+Solu.Offset(0,+Sarake+-+1)+&+",+"++++End+IfNextOmaPHaku+=+Left(Tulos,+Len(Tulos)+-+2)End+FunctionKeep+EXCELing@Kunde
  18. Mitä+olet+tutkimassa+Mitä+ovat+noi++x+ja+y+ja+niiden+suhdevirhemarginaaliei++voi+ihan+lonkalta+antaa+vastausta+ei+lineaariseen+ensiksi+sun+pitää+selvittää+miten+arvot+käyttäytyvät+eli+selvittää+funktion+muoto+ja+kaava+sille+sen++jälkeen+tehdä++hieman+esivalmisteluja+ja+sitten+EXCElin++raikaisija+avuksi+...
  19. ajattelin,+että+pitäisi+kyllä++olla+helpompikin+keino+säädellä+kopioitavan+alueen+sarakkeiden+paikkaa+ja+määrää...Sub+Siirrä()Dim+vika+As+LongDim+ar+As+Variantvika+=+Worksheets("Sheet2").Range("B65536").End(xlUp).Row+++1With+Sheet1.Range("B4:O100")'arrayssa+voit+määritellä+kopioitavien+sarakkeiden+järjestyksen+ja+samalla+määrän+;-)+...++++++++ar+=+Application.Index(.Value,+Evaluate("row(1:100"+&+")"),+Array(1,+2,+3,+8,+6,+7,+9,+10,+11,+12,+13,+14))++++++++Worksheets("Sheet2").Range("B"+&+vika).Resize(UBound(ar),+12)+=+arEnd+WithEnd+SubKeep+EXCELing@Kunde
  20. ei+ihan+vastaa+toi+solualue+taulukko2;ssa,+mutta+ei+väliä.+Muuta+koodissa+nimet+ja+alueet+sopiviksi.Sub+Siirrä()Dim+vika+As+Longvika+=+Worksheets("Sheet2").Range("B65536").End(xlUp).Row+++1With+Worksheets("Sheet1")Union(.Range("B4:D100"),+.Range("J4:J100")).Copy+Worksheets("Sheet2").Range("B"+&+vika)Union(.Range("G4:I100"),+.Range("K4:O100")).Copy+Worksheets("Sheet2").Range("F"+&+vika)End+WithEnd+Subkeep+EXCELing@Kunde
    21. 8 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt