kunde
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 sitten
Muokkaa profiilia7 aloitusta · 1377 kommenttia
- ko taulukon moduuliin...
nyt tuplaklikkaamalla solua alueella lisää soluun X ja pienentää vastaavan solun rivin A sarakkeen arvoa -1 ja jos nolla ei tee mitään.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("C1:Z36"), Target) Is Nothing Then
Target = "X"
If Range("A" & Target.Row) = 0 Then
Else
Range("A" & Target.Row) = Range("A" & Target.Row) - 1
Target.Offset(0, 1).Select
End If
End If
End Sub - ko taulukon moduuliin...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Target.ID = "" Then
Target.ID = Target
Target.Offset(0, 1) = 1
Else
If Not Target.ID = Target Then
Target.Offset(0, 1) = Target.Offset(0, 1) 1
Target.ID = Target
End If
End If
End If
End Sub
Keep EXCELing
@Kunde - Varmaan aloittejilla helpoin tämä kirjainmerkki toteuttaa...
Excelissä on 10 firman tiedot ja siirtää ne Lasku.docx kirjainmerkkeihin ja tekee niistä 10 uutta tiedostoa firman nimellä...
https://www.dropbox.com/s/v6evx4y22fehonm/Exceltesti.zip?dl=0
Keep EXCELing
@Kunde - -Kaikki VBA ohjeet skippasin samantien, koska se on liian vierasta aluetta. Eri asia jos joku lyö valmiin koodin.
vaikeetahan toimivaa koodia on tehdä tässä tapauksessa kun, e i tiedä mitä siirretään yksittäisiä soluja , solu alue tms.
Parilla eri tapaa ton vois tehdä, jos enemmän infoa olisi saatavilla... - Viel' helpompaa taitaa olla VBA:lla käyttää Wordin Activedocument.variables ....
silloin tiedot on itse Wordin tiedostossa ja rivien määrä putoaa ehkä alle 10 riviin....
Keep EXCELing
@Kunde - jaa ei vain...
VBA..
Tarvitset Excelissä vain viittauksen Wordiin
Wordissä teet liitettäville Excelin soluille kirjainmerkit tyyliin Nimi.Osoite... ja tallennat.
Koodilla avaat Wordin ja liität Excelistä tiedot kirjainmerkkeihin ja tallennat yrityksen nimellä.
Luulisin , että noin 20 riviä koodia tarttee....
Keep EXCEling
@Kunde - Voithan sä sen makron liittää suoraan ennen sulkemista tapahtumaankin, jolloin tota aukeamistapahtuman makroa ei sitten tarvitse ja suorittaa sen sun makron automaattisesti...
Private Sub Workbook_BeforeClose(Cancel As Boolean)
tähän oman makro kutsu
End Sub
Keep EXCELing
@Kunde - Kun Excel aukeaa, niin voit liittää siihen makron. Mutta jos 1 pikku makro on liikaa, niin sitten manuaalisesti vaan..
Private Sub Workbook_Open()
Worksheets(1).Range("E27") = 1
End Sub - Eli oikein sitten ymmärsin. Jälkeenpäin huomasin , että olin manuaalisesti tehdessä kuvamallia mokannut...
Keep EXCELing
@Kunde - ei ole virhetarkastelua lisättynä
inputboxissa on nyt sallittu vain numerot ja sen virhettä vo käsitellä helpostikini
Sub Tulosta()
Dim Alku As Long
Dim Loppu As Long
Dim i As Long
Alku = Application.InputBox("Anna sarjanumero mistä aloitetaan", 1)
Loppu = Application.InputBox("TULOSTETTAVIEN SARJANUMEROIDEN MÄÄRÄ", 1)
For i = Alku To Alku Loppu
Range("D11") = Format(i, "0000")
Range("D11").NumberFormat = "@"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next
MsgBox ("Tulostus valmis"), 64, "Huomautus!"
End Sub - Tarkista solun muotoilu...
jjos päiväys tulee pillkulla, niin silloin sulla väärä muotoilu solussa - ilman turhia luuppauksia
Sub Korvaa()
Dim originaalit As Variant
Dim korvaavat As Variant
Dim x As Long
originaalit = Array("A", "B", "C", "a", "b", "c")
korvaavat = Array("X", "Y", "Z", "x", "y", "z")
For x = LBound(originaalit) To UBound(originaalit)
Selection.Replace What:=originaalit(x), Replacement:=korvaavat(x), _
LookAt:=xlPart, MatchCase:=True
Next
End Sub
Keep EXCELing
@Kunde - Eihän toi makro toimi niinkuin aloittaja pyytelee...
Liitä nappiin koodi
aivan pelkistettynä nyt.
Ton voi helposti tehdä Change tapahtumaan 3 sarakkeelle, jolloin kun lisää projektiin työvaiheen tietoja niin automaattisesti päivittyy kaavion ja ei tartte erikseen klikkailla nappia
Sub SiirräData()
'maalaa alue - joko pelkät ajat tai myös projektin vaihe ja hipssa oikea vaihto ehto käyttöön
'alku ja loppupäivät vaan
Selection.Copy Range("D6")
' projektin vaihe alku ja loppupäivät
Selection.Copy Range("C6")
End Sub
Keep EXCELing
@Kunde - Sub example_DATE()
Range("B3").Value = Date
End Sub
ei voi toimia, kun ei sitä mistään kutsuta...
jos haluat, että se päivittyy kun, joku sarakkeen C solu muuttuu, niin koodi silloin ja example_DATE() tavallisessa moduulissa
ko taulukon moduuliin...
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C:C"), Target) Is Nothing Then
example_DATE
End If
End Sub
automaatisesti avatessa päivyttävä kood(päivittyy vain tiedostoa avattaessa)
ThisWorkbook moduuliin...
Private Sub Workbook_Open()
Range("A1") = Date
End Sub
vastaava vain suljettaessa sourotettava koodi
Private Sub Workbook_Close()
Range("A1") = Date
End Sub
jos koodilla haluat tehdä automaattisen päivityksen, kun tehdään uudelleen laskenta, tarvitaan koodiin lisätä volatile true
soluun, mihin haluat automaatisesti päivityksen(voi olla mitä tahansa koosissa, ei siis vain päiväys) laitat kaavan =päiväys()
tavalliseen moduuliin...
Function Päiväys() As Date
Application.Volatile True
Päiväys = Date
'sama muotoiltuna päiväyksenä
'Päiväys = Format(Date, "dddd")
End Function
NOW() ja TODAY() kyllä päivittyvät, jos taukossa tapahtuu uudelleenlaskenta...
Keep EXCELing
@Kunde - Avainsana on volatile functiions...
http://www.decisionmodels.com/calcsecretsi.htm
Keep EXCELing
@Kunde - moduuliin...
Tallentaa viimeksi tallenetun tekstitedoston nimen muuttujaan VikaTiedostonnimi
Tallentaa viimeksi tallenetun tekstitedoston tallennusajan muuttujaan VikaPäiväys
Option Explicit
Dim Polku As String
Dim Tiedostonnimi As String
Public VikaTiedostonnimi As String
Public VikaPäiväys As Date
Dim TallennusPäiväys As Date
Sub Uusintiedosto()
'muuta polku ja tiedostopääte sopivaksi
Polku = "C:\Kunde\"
Tiedostonnimi = Dir(Polku & "*.txt", vbNormal)
If Len(Tiedostonnimi) = 0 Then
MsgBox "Ei löytynyt tekstitiedostoja...", vbExclamation
Exit Sub
End If
Do While Len(Tiedostonnimi) > 0
TallennusPäiväys = FileDateTime(Polku & Tiedostonnimi)
If TallennusPäiväys > VikaPäiväys Then
VikaTiedostonnimi = Tiedostonnimi
VikaPäiväys = TallennusPäiväys
End If
Tiedostonnimi = Dir
Loop
End Sub
Keep EXCELing
@Kunde - Koodit on postattu vuonna 2014 ja silloin ei ollut tommosia ongelmia . Foorumin ulkonäköä fiksailtu ja uusittu sen jälkeen ja koodista kadonnut sitten noita tiettyjä merkkejä...
- foorumi hukannut ja- merkin &
eli pitäisi olla
"HaeArvot = HaeArvot (tähän ja- merkki )Solu.Offset(0, 3).Value
tähän merkit kohtaan ilman sulkuja siis ja-merkki &
Keep EXCEling
@Kunde - Koodasin alkuperäisen taulukon mukaisesti ja siinähän oli päiväykset A-sarakkeessa tyyliin
A5=1.12
A12=2.12 jne
tämän perusteella sitten kokosin ton kokoomajutun eli siinä on siis 7 riviä päivää kohden...
Mutta nyt kertomasi perusteella siis vain 1 rivi/pv ja silloinhan tuo olisi ollut aivan simppeli tapaus vs nykyinen 7 priviä tapaus...
voit lähettää emailin mulle, missä kaikki olisi niinkuin haluat,, niin helpompi tehdä kerralla oikein kuin arvailla
Keep EXCELing
@Kunde - https://www.dropbox.com/s/7ixav9p44d7tzkc/Kelpoisuusehto oikea valikko.xlsm?dl=0
Keep EXCELing
@Kunde