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
A1=0 B1=34,32
A2=50 B2=74,38
A3=400 B3=214,54
A4=1000 B4=471,99
A5=2000 B5=901,08
A6=5000 B6=1759,24
A7=99999 B7=TYHJÄ

E1=KUUTIOHINTA
E2=VEDENKULUTUS KUUTIOINA
E3=E1*E2
E4==VLOOKUP(E2;A1:B6;2;1)
E5=E4+E3

A7 arvo oltava tarpeeksi iso, eli ettei vahingossakaan tule käytettyä...
hakee nyt vain asiakkaan nimen ja osoitteen samalle riville ja allekkain aktiiviseen taulukkoon

moduuliin...

Sub HaeTiedosotosta()
'hakee tiedostosta vain nimi ja osoitetiedot allekkain Excelin aktiiviseen taulukkoon
'tiedostorakenne
'Nimi: Matti Meikäläinen
'Osoite: Koulukuja 1
'...
'Nimi: Liisa Teikäläinen
'Osoite: Koulukuja 2
'...

Dim Tiedosto As String
Dim Haku1 As String
Dim Haku2 As String
On Error Resume Next

'muuta polku ja hakusanat oikeaksi
Tiedosto = "C:\kunde\koe.txt"
Haku1 = "Nimi"
Haku2 = "Osoite"

Range("A:B") = ""
Range("A1").Select
Open Tiedosto For Input As #1
While Not EOF(1)
Line Input #1, textline
If InStr(1, textline, Haku1, 1) > 0 Then
' jos oli Nimi: alussa niin tuo 7 merkistä alkaen, korjaa oikeaksi
ActiveCell = Mid(textline, 7)
End If
If InStr(1, textline, Haku2, 1) > 0 Then
' jos oli Osoite: alussa niin tuo 9 merkistä alkaen, korjaa oikeaksi
ActiveCell.Offset(0, 1) = Mid(textline, 9)
ActiveCell.Offset(1, 0).Select
End If
Wend
Close #1
End Sub
If Not Intersect(Target, Range("A1")) Is Nothing
joka siis tarkoittanee, että jos alueet leikkaavat, mutta Not Intersect sanois ihan kuin ei leikkaa.

eli ei leikkaus(aktiivinen solu ja tarkasteltava solualue/solut) ei ole mitään

eli jos leikkaa- ei oo mitään =FALSE ja ei kääntää sen TRUE ja koodi suoritetaan...
jos ei leikkaa- ei oo mitään on =TRUE ja ei kääntää sen FALSE ja koodia ei suoriteta

leikkauksessa -argumenttejä voi olla muistaakseni 30 kpl ja jos nimettyjä alueita käyttää niin melkoisen alueen saa katettua
leikkasiko ;-)

kepp Excelling
@Kunde
ko taulukon moduuliin...

Private Sub Worksheet_Change(ByVal Target As Range)
'laskee solun A1 arvoja soluun C1
If Not Intersect(Target, Range("A1")) Is Nothing Then
Range("C1") = Range("C1") + Target
End If
End Sub
no laiskuus päällä edellen ja loppuviikko meneekin uuden CNC koneen parissa...
mutta jospa virkistytään, niin siltä varalta muutama kyssäri ;-)

Ylläpidän erään firman verkkokauppaa ja sitä olis tarkoitus päivittää suh tiheään tahtiin.
Käytän kahta eri taulukkoa (tai 2 eri välilehteä)
- toinen on verkkokaupasta tallennettu csv tiedosto jonka tallennan xls muotoon (olkoon nimi vaikka verkkokaupantuotteet.xls tai saman niminen sheet)
- ja toinen on toiminnanohjausjärjestelmästä poimittu tiedosto (toj_tiedot.xls tai saman niminen sheet)

mikä on tiedoston rakenne?
saakos toj_tiedot.xls kanssa csv muodossa? jos saa niin helpottaa koodaamista...

Tarkoitus olisi saada nämä kaksi tiedostoa keskustelemaan paremmin.
Tällähetkellä käytän
- phaku -funktiota suositushintojen hakuun
- summa.jos -funktiota varastosaldojen päivitykseen.

verkkokaupantuotteet.xls voi olla eri hinta kuin verkkokaupantuotteet.xls?
verkkokaupantuotteet.xls voi olla eri varastosaldo kuin verkkokaupantuotteet.xls?
missä sarakkeessa on tuote mitä tsekkaillaan?
missä sarakkeissa on hinta/varastosaldo?
mitenkäs käsitellään jos eri hinta tai varasto saldo? miten ja mihin siirretään tietoa?

Päänvaivaa aiheuttaa uudet tuotteet joita ilmestyy toiminnanohjausjärjestelmään suh tiheään.
Olisiko jokin funktio tai toiminto jolla voisin poimia / verrata näitä kahta listaa ja siten että ko. toiminto osaisi lisätä uudet tuotteet tuonne verkkokaupantuotteet.xls listaukseen?

no problem jos edelliset kohdat tiedetään...

Nyt teen tätä manuaalisesti ja ottaa pirukseen aikaa käydä aina läpi yli 2000 tuotetta.

uskotaan... ;-)
jos hyvin vastailet niin voi olla, että laiskottelu lakkaa (555)
että Excelissä helpompaa vielä ton kokosen tiedostojen käsittely- varsinkin jos joudut suorittamaan laskutoimituksia, niin silloin vaaka kallistuu aina enemmän Excelin puolelle.
Ainahan voi apuna käyttää VBA:ta ja ottaa käyttöön tarvittavia osia Accesista Exceliin (mitähän nyt tartteis?- ei tuu mieleen :-))
Keep Excelling!
@Kunde
scannaa postikortti ja liitä kuva sitten Exceliin.
Lisää tarvittavat tekstikentät oikeisiin kohtiin ja jne...
tolla se hoituu kivuttomasti, mutta laiskottaa nyt ... joten googleta ;-)
mutta koodilla sen saa automaattisesti tekstiksi ja manuaalisestikin sen voi tehdä jälkikäteen klikkaamalla solussa hiiren oikealla ja avautuvasta valikosta EDIT HYPERLINK/REMOVE LINK, mutta työlästähän tommonen naksuttelu

ko. taulukon moduuliin...

Poistaa nyt aina kirjoitetusta solusta hyperlinkin.
Muokkaamalla helposti vain tietylle alueelle yms.

Private Sub Worksheet_Change(ByVal Target As Range)
Target.Hyperlinks(1).Delete
End Sub
joo kerrohan se puutelistasi...
itse aikanani tein näin...
Kirjoittelin Excelillä kaikki doccarit ja lisäsin VBA:n avulla koodilla aina tarvittavia Wordin ominaisuuksia Exceliin (mm. oikoluku). Oli paljon paljon helpompaa kuin tuskailla Wordin kanssa...
@Kunde
tee kuten MäVaanTäällä neuvoi eli
"No esimerkiksi solussa A1 = 2, laita soluun A2 kaava = A1*2. Tämän jälkeen kopioit alaspäin seuraaviin soluihin "
kopioi alue ja liitä takaisin vain arvoina.
ei ole muuta tapaa kuin koodilla tehdä kysymäsi juttu.
Kannattaisi sen verran ohjeita lukea, että osaa napin tehdä ja koodin siihen liittää.. ;-)
liitä koodi nappiin

Sub Siirryalaviitteeseen()
Dim numero As Integer
On Error Resume Next
numero = InputBox("Anna alaviitteen numero")
Selection.GoTo What:=wdGoToFootnote, Which:=wdGoToFirst, Count:=numero
End Sub
Kiinnostus heräsi ja tsekkasin makron mahdollisuutta...
Wordissahan voi tehdä 9 eri otsikkotasoa maksimissaan, mikä lienee riittää sukupuussakin ikäpolviksi???
eli helpommalla pääsee kun valitsee valikosta näkymäksi VIEW/OUTLINE
sitten vaan alkaa kirjotteleen sukupuuta tyyliin
1 otsikko oma nimesi
2 otsikko(sisennyksellä) äiti
3 otsikko(sisennyksellä) äitin äiti
3 otsikko(sisennyksellä) äitin isä
2 otsikko(sisennyksellä) isä
3 otsikko(sisennyksellä) isän äiti
3 otsikko(sisennyksellä) isän isä
4 jne...

ja sitten vaan suorittaa makron...
ja sukupuu siististi uudessa dokkarissa...

liitä moduuliin...
Sub OrganisaatioKaavio()

Dim doc As Document
Dim para As Paragraph
Dim Teksti As String
Dim nodeRoot As DiagramNode
Dim Laatikko As Shape
Dim node1 As DiagramNode
Dim node2 As DiagramNode
Dim node3 As DiagramNode
Dim node4 As DiagramNode
Dim node5 As DiagramNode
Dim node6 As DiagramNode
Dim node7 As DiagramNode
Dim node8 As DiagramNode
Dim node9 As DiagramNode

On Error Resume Next

Set doc = ActiveDocument
Set Laatikko = Documents.Add.Shapes.AddDiagram(msoDiagramOrgChart, 0, 0, 500, 500)
Set nodeRoot = Laatikko.DiagramNode.Children.AddNode
nodeRoot.TextShape.TextFrame.TextRange.Text = "Sukupuu"

For Each para In doc.Paragraphs
Select Case para.OutlineLevel
Case wdOutlineLevel1
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node1 = nodeRoot.Children.AddNode
node1.TextShape.TextFrame.TextRange.Text = Teksti
Set node2 = Nothing
Set node3 = Nothing
Set node4 = Nothing
Set node5 = Nothing
Set node6 = Nothing
Set node7 = Nothing
Set node8 = Nothing
Set node9 = Nothing

Case wdOutlineLevel2
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node2 = node1.Children.AddNode
node2.TextShape.TextFrame.TextRange.Text = Teksti
Set node3 = Nothing
Set node4 = Nothing
Set node5 = Nothing
Set node6 = Nothing
Set node7 = Nothing
Set node8 = Nothing
Set node9 = Nothing

Case wdOutlineLevel3
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node3 = node2.Children.AddNode
node3.TextShape.TextFrame.TextRange.Text = Teksti
Set node4 = Nothing
Set node5 = Nothing
Set node6 = Nothing
Set node7 = Nothing
Set node8 = Nothing
Set node9 = Nothing

Case wdOutlineLevel4
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node4 = node3.Children.AddNode
node4.TextShape.TextFrame.TextRange.Text = Teksti
Set node5 = Nothing
Set node6 = Nothing
Set node7 = Nothing
Set node8 = Nothing
Set node9 = Nothing

Case wdOutlineLevel5
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node5 = node4.Children.AddNode
node5.TextShape.TextFrame.TextRange.Text = Teksti
Set node6 = Nothing
Set node7 = Nothing
Set node8 = Nothing
Set node9 = Nothing

Case wdOutlineLevel6
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node6 = node5.Children.AddNode
node6.TextShape.TextFrame.TextRange.Text = Teksti
Set node7 = Nothing
Set node8 = Nothing
Set node9 = Nothing

Case wdOutlineLevel7
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node7 = node6.Children.AddNode
node7.TextShape.TextFrame.TextRange.Text = Teksti
Set node8 = Nothing
Set node9 = Nothing

Case wdOutlineLevel8
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node8 = node7.Children.AddNode
node8.TextShape.TextFrame.TextRange.Text = Teksti
Set node9 = Nothing

Case wdOutlineLevel9
Teksti = Left(para.Range.Text, para.Range.Characters.Count - 1)
Set node9 = node8.Children.AddNode
node9.TextShape.TextFrame.TextRange.Text = Teksti
End Select
Next para
End Sub

Keep Wording
@Kunde
arvelisin, että syötät koodissa päiväyksen tekstinä tyyliin...
Range("A10") = "1.1.2009"

sensijaan syötä se seuraavasti
Range("A12") = CDate("1.1.2009")
ja muotoilut toimii OK.

Keep Excelling
@Kunde
kuinka moneen soluun, mutta tosiaankin miksi?
no allaolevalla koodilla onnistuu
VBA työkaluista valintaruutu ja liität koodin siihen...

Private Sub CheckBox1_Click()
If CheckBox1 Then
Range("A1:A2") = "TRUE"
Else
Range("A1:A2") = "FALSE"
End If
End Sub
vaan ominaisuus. Kuten eilen vastasin samantapaiseen aikaongelmaan. Jos haluat, että koodisi toimii oiken käytä jenkkityylin päiväyksiä ja toimii. Mutta koska Excel tallentaa päiväykset numeroina, niin silloin helpompi tapa toimia "kansainvälisesti" on muuttaa päiväykset luvuiksi ja no problem.
Kuten itsekin totesit niin toimii lukuna...

Keep Excelling
@Kunde
muuta polku sopivaksi tiedostollesi...

Sub Muokattuviimeksi()
Dim Päiväys As Date
Päiväys = FileDateTime("X:\koe.xls")
MsgBox Päiväys
End Sub

Keep Excelling
@Kunde
virhettä pukkaa tolla rivillä
MsgBox "Päiväys on " & Format(eomonth(MaksimiPvm, -1), "dd.mm.yyyy")

muutin koodia ja nyt ainakin mun koneella toimii niinkuin pitääkin...

Sub testi()
Dim MaksimiPvm As Date
MaksimiPvm = Fix(Application.WorksheetFunction.Max(Range(Cells(1, 1), Cells(2, 1)))) + 1
MsgBox "Päiväys on " & Format(Evaluate("=EOMONTH((A1), -1)"), "dd.mm.yyyy")
End Sub

Keep Excelling
@Kunde
päivämäärät on usein kinkkisiä excelissä. Toimiakseen lajittelussa vaatii jenkkityyliset päiväykset, mutta koska Excel tallentaa päivät numeroina niin ne kannattaa muuttaa luvuiksi

korjasin hiukan koodiasi ja nyt se toimii

Sub vuosi()
Dim v As Integer
Dim Päiväys1 As Long
Dim Päiväys2 As Long
Range("A3").Select
v = Application.InputBox("Anna vuosi muodossa VVVV", Type:=1)
Päiväys1 = DateSerial(v, 1, 1)
Päiväys2 = DateSerial(v + 1, 1, 1)
Selection.AutoFilter Field:=1, Criteria1:=">=" & Päiväys1, Operator:=xlAnd, _
Criteria2:="
49 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt