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. 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...
  2. 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
  3. 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
  4. automaatisesti+löydät+sarakkeen+VBA:ssa+Application.WorksheetFunction.Match(cdbl(Date),+Range("8:8"))Keep++EXCEling@Kunde
  5. 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
  6. 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
  7. 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
  8. 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
  9. 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
  10. 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
  11. 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
  12. 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.
  13. 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
  14. 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
  15. 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+...
  16. 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
  17. 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
  18. höpö+höpö...ei+tartte++tallentaa+ennen+makron+suorittamistamuuta+taulukon+nimi+sopivaksiSub+TallennaPDF()++++ActiveSheet.ExportAsFixedFormat+Type:=xlTypePDF,+Filename:=+_++++++++"C:\Users\Kunde\Desktop\"+&+Worksheets("Taul1").Range("B1")+&+".pdf",+Quality:=xlQualityStandard,+_++++++++IncludeDocProperties:=True,+IgnorePrintAreas:=False,+OpenAfterPublish:=+_++++++++TrueEnd+SubKeep+EXCELing@Kunde
  19. tarkoitat+varmaan+tätät+koodia?Function+SivunNimi(n)+++SivunNimi+=+Sheets(n).NameEnd+Functionse+ei+päivity+ja+ongelma+myös+siinä,+jos+siirrät+taulukkoa+palauttaa+väärän+taulukon++nimen.+Ainoat+keinot+on+APi+ja+toi+allaoleva+koodini,+jotka+palauttavat++oikean+taulukon+siirtelee+sitä+tai+ei.tämä+päivittyyFunction+SivunNimi(n)Application.+Volatile+++SivunNimi+=+Sheets(n).NameEnd+FunctionKeep+EXCELing@Kunde
  20. Sub+koe2()Dim+Solu+As+RangeDim+i+As+Longi+=+1With+Worksheets("Taul2").Range("A:A")+=+""For+Each+Solu+In+Worksheets("Taul1").Range("A1:A10")++++If+Not+Solu.Offset(0,+1)+=+""+Then++++++++.Range("A"+&+i).Resize(Solu.Offset(0,+1))+=+Solu++++++++i+=+i+++Solu.Offset(0,+1)++++End+IfNextEnd+WithEnd+Subkeep+EXCELing@Kunde
    21. 8 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt