kunde

kunde profiilikuva
Joulu 2024
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

Liittynyt 20v sitten
7 aloitusta · 1377 kommenttia
Uusimmat aloituksetSuosituimmat aloituksetUusimmat kommentit
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
Worksheets("Taul3").Range("B:B") = ""
Worksheets("Taul4").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Offset(0, 1).Resize(1, 11).Copy
Select Case LCase(solu)
Case "ympyrä"
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case "neliö"
Range("Taul3!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case "kolmio"
Range("Taul4!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Case Else
End Select
Next
Application.CutCopyMode = False
End Sub
Sub Transponoi()
Dim vika As Integer
Dim solu As Range
Worksheets("Taul2").Range("B:B") = ""
vika = Range("Taul1!A65536").End(xlUp).Row
For Each solu In Range("Taul1!A1:A" & vika)
solu.Resize(1, 11).Copy
Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next
Application.CutCopyMode = False
End Sub

keep Exceling ;-)
@Kunde
tuolta voit latailla apuohjelman, jolla tarkkuudet kohdallaan...
http://xlprecision.precisioncalc.qarchive.org/
excel käyttää IEEE (Institute of Electrical and Electronic Engineers)standardia numeroiden varastoimiseen ja sen tarkkuus on 15 numeroa ja sen jälkeiset luvut pyöristetään. Ainoastaan tekstinä voit näyttää isompia lukuja.
kopioi toisen taulukon tiedot toiseen taulukkoon ja suodata uniikit...
en ole tarkistanut originaalikoodin toimivuutta...

Private Const dsWarningSheet As String = "sheet6" 'Enter name of the Entry/Warning Page

   Private Sub Workbook_Beforesave(ByVal SaveAsUI As Boolean,
Cancel as Boolean)
For Each ds In ActiveWorkbook.Sheets
If LCase(dsWarningSheet) = LCase(ds.Name) Then
ds.Visible = True
Else
ds.Visible = xlVeryHidden
End If
Next

If SaveAsUI = True Then Cancel = True

End Sub

   Private Sub Workbook_SheetSelectionChange(ByVal ds As Object, ByVal Target As Excel.Range)
If LCase(ds.Name) = LCase(dsWarningSheet) Then
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveSheet.Visible = xlVeryHidden
End If
End Sub

   Private Sub workbook_open()
Sheets(dsWarningSheet).Select
For Each ds In ActiveWorkbook.Sheets
ds.Visible = True
Next
ActiveSheet.Visible = xlVeryHidden
End Sub
oli koneella probleemia ja ei pystynyt lähettämään viestiä ja edellinen onkin jo kertonut samat jutut sillä aikaa...
Ainahan käyttäjä voi ajaa toiselta työkirjalta makron ja tehdä mitä vaan sun työkirjallesi jos ohjelmointitaitoa riittää...
No asiaan.
Makrojen suojaustasoa voit muuttaa alhaiseksi,jolloin makrojen hyväksyntää ei kysellä tai sitten teet makron, joka tekee seuraavaa
1. Suljettaessa tai tallennettaessa piilotetaan kaikki taulukot paitsi yksi ns. pääsivu. Tälle sivulle infoa, jolla kerrot, että käyttäjän on otettava makrot käyttöön käynnistämällä työkirja uudelleen.
2. Jos käyttäjä ei hyväksy makroja avataan excel ja vain pääsivu näkyy...
3.Jos hyväksyy makrot niin toimii normaalisti. Käytä Excelin xlVeryHidden ominaisuutta piilottaessasi taulukot, jolloin niitä ei saa näkyviin menun kautta
Keep Exceling :-)
ei kovin vaikeaa...
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'vasemmalle
ActiveSheet.PageSetup.LeftFooter = Range("A3")
'keskelle
'ActiveSheet.PageSetup.CenterFooter = Range("A3")
'oikealle
'ActiveSheet.PageSetup.RightFooter = Range("A3")
End Sub
Nyt funktio on VOLATILE funktio, joka päivittyy aina kun taulukossa tehdään uudelleenlaskenta. Kokeile vaikka seuraavasti.
esim.
soluun A1 =NYT()ja siihen oma solumuotoilu t:mm:ss ja sitten painelet funktionäppäintä F9
Muuttuiko aika?

Keep Excelling :-)
ThisWorkBook moduuliin...

muuta koodissa solun osoite

Makro päivittää päiväyksen juuri ennen tulostusta
Toinen keino on painaa F9 näppäintä juuri ennen tulostusta, jolloin excel tekee uudelleen laskennan kaavoille ja VOLATILE funktioille( Nyt()on tähän ryhmään kuuluva funktio)

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Range("A1") = Now()
End Sub
vai ei excel osaa laskea yli 24 meneviä tunteja. taidatkin olla JMS koulutuksen saaneita huippuosaajia...
mutta voihan suodatettavan kentän otsikkorivin vaihtaa helposti...
alla oleva koodi vaatii jonkun excelin VOLATILE funktion käyttämistä ko taulukossa
jaa, että mitä ne VOLATILE funktiot on? Jääköön se lukijan selvitettäväksi, mutta lisää taulukkoosi johonkin soluun kaavaksi esim lontoonkielellä =TODAY tai suomiversiossa =TÄMÄ.PÄIVÄ() niin allaoleva koodi toimii...
eli koodi muuttaa suodatetun kentän taustavärin nyt keltaiseksi, joten sen ainakin huomaa

taulukon moduuliin...

Private Sub Worksheet_Calculate()
Dim SuodatusRivi As Integer
Dim laskuri As Integer
Dim Kentat As Integer
On Error Resume Next
Application.EnableEvents = False
SuodatusRivi = Me.AutoFilter.Range.Row
Kentat = Me.AutoFilter.Filters.Count
Range(Cells(SuodatusRivi, 1), Cells(SuodatusRivi, Kentat)).Interior.ColorIndex = xlNone
If ActiveSheet.FilterMode = True Then
For laskuri = 1 To Kentat
If ActiveSheet.AutoFilter.Filters.Item(laskuri).On Then
'nyt keltainen muuta allaolevaa numeroa
Cells(SuodatusRivi, laskuri).Interior.ColorIndex = 6
End If
Next laskuri
End If
Application.EnableEvents = True
On Error GoTo 0
End Sub
Suomenkielisilla kirjoilla voi pyyhkia per*****. Samat ikivanhat esimerkit ja muutenkin ihan ala-arvoisia. Jos lontoon murre hallussa niin osta kirja.Muutama suositeltava kirja on...
Lue ulkolaisia foorumeita ja tutki niiden koodeja
Nauhoita makroja ja opettele "siistimaan" niita
P.S. pian aukeaa Kunden portaali, jossa sitten ssat asiatietoa ihan suomen kielella ja voit lahetella tiedostoja yms...
kunhan nyt saisin suomikaannokset valmiiksi foorumille... mutta ei nin hirveesti jaksa taalla Thaimaassa...
Vba:lla piece of cake.

Mutta neuvotaanpa tällä kertaa ilman sitä.

1. lisää listaasi otsikkorivit(ellei niitä jo ole) tyyliin etunimi, sukunimi,osoite...
2. valitse lista ja luo listalle nimet Lisää/Nimi/Luo/luo nimet yläriviltä ja vasemmasta sarakkeesta.
3. kirjoitat sitten uuteen listaasi kaavat ja kopioit niitä alaspäin
esim A sarakkeessa nimet, B sarakkeessa osoite

esim. osoite (B)sarakkeeseen
=EPÄSUORA(A4) osoite ja kaava hakee listasta Ville Virtasen (solu A4) osoitteen esim Tilatie 1 B 36

ei kummonen juttu ja helppo muistaa kaavat
moduuliin...
avatessa lisää lukua

Sub Auto_Open()
Range("A1") = Range("A1") + 1
End Sub

suljettaessa lisää lukua

Sub Auto_Close()
Range("A1") = Range("A1") + 1
End Sub

vaihtoehtoisesti ThisWorkbook moduuliin...

lisää lukua suljettaessa

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Range("A1") = Range("A1") + 1
End Sub

lisää lukua tulostettaessa

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Range("A1") = Range("A1") + 1
End Sub

lisää lukua tallennettaessa

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Range("A1") = Range("A1") + 1
End Sub

käytä vaan yhtä noista ja oman makronhan voi aina tehdä...
vaihtoehtoja riittää

Sub Joku()
Range("A1") = Range("A1") + 1
End Sub

Keep Excelling ;-)
@Kunde
liitä makro ohjeiden mukaan ja tallenna työkirja, Makro toimii siinä taulukossa mihin koodin liitit automaattisesti. Eli kun syötät luvun A sarakkeeseen lisää sen vastaavaan B sarakkeen lukuun. Ei toimi muissa sarakkeissza vain ja ainosataan kun A sarakkeen solun arvo muuttuu
Taul1 tai mihinka olemassa olevaan taulukossa haluat koodin toimivan liita se ko taulukon moduuliin Projektin hallinta/Excelin objektit.Taulukon moduulit(niissa on taulukon kuva) on ThisWorkbook(vihrea x valkealla paperilla) moduulin ylapuolella.Ala lisaa uutta moduulia.
nyt lisaa myos rivin, olikin tullut tuplana toi koodi...

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo virhe:
Application.EnableEvents = False
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If IsNumeric(Target) Then
Target.Offset(0, 1) = Target.Offset(0, 1) + Target
Target.Offset(1, 0).EntireRow.Insert
Else
MsgBox "syottamasi arvo ei ollut luku! "
Target.Select
GoTo virhe
End If
End If
virhe:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If IsNumeric(Target) Then
Target.Offset(0, 1) = Target.Offset(0, 1) + Target
Else
MsgBox "syott?m?si arvo ei ollut luku! "
Target.Select
Exit Sub
End If
End If
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If IsNumeric(Target) Then
Target.Offset(0, 1) = Target.Offset(0, 1) + Target
Else
MsgBox "syottamasi arvo ei ollut luku! "
Target.Select
Exit Sub
End If
End If
End Sub
1. tee Visual Basic tyokaluvalikosta combobox taulukkoon haluaamisi kohtaan
2. laita comboboxin ListFillRange kohtaan lista hyperlinkeista tyyliin A1:A10
3.liita allaoleva koodi comboboxiin

Private Sub ComboBox1_Change()
Range("A1").Offset(ComboBox1.ListIndex, 0).Hyperlinks(1).Follow
End Sub

oleuksena nyt, etta hyperlinkit alkaa solusta A1 muuta sita tarvittaessa

Keep Excelling :-)
62 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt