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
ActiveCell.Offset(0, 5).Range("A1").Select '5 solua oikealle
ActiveCell.Offset(0, -5).Range("A1").Select '5 solua vasemmalle
ActiveCell.Offset(5, 0).Range("A1").Select ' 5 solua alas
ActiveCell.Offset(-5, 0).Range("A1").Select ' 5 solua ylös
laita otsikot
A1=ryhmä B1=nimi D1=ryhmä
A4=ryhmä B4=ryhmä

solusta A5 alkaen dataa

soluun D2 kelpoisuusehto a,b,c
soluun A2 kaava =D2

taulukon moduuliin...

Private Sub Worksheet_Calculate()
Dim vika As Integer
On Error GoTo virhe:
Application.EnableEvents = False
vika = Range("D65536").End(xlUp).Row
Range("D4:E" & vika) = ""

vika = Range("A65536").End(xlUp).Row

Range("A4:B" & vika).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("D4"), Unique:=False

virhe:
Application.EnableEvents = True
End Sub
Excelissä tosiaan 256 saraketta, mutta officen Web komponenttien Spreadsheet komponentissä on sarakkeita ZZZ asti(18278-mahtuu about 50 vuotta...)
Ei muuta kuin lisäät userformin ja sinne toi web objekti ja kalenteria väsäämään
;-)
etpähän maininnut alkujaan, että solussa useampi muotoilu...
no nyt koodi tekee haluamasi

Sub TekstiSiirto()
Dim vika As Integer
Dim a As Variant
Dim Alku As Integer
Dim Pituus As Integer
On Error Resume Next
Application.ScreenUpdating = False
vika = Range("B65536").End(xlUp).Row

For Each solu In Range("B1:B" & vika)
a = Split(solu, " ") ' erottimena välilyönti
Alku = 1
For i = 1 To UBound(a) + 1
Pituus = Len(a(i - 1))
väri = solu.Characters(Start:=Alku, Length:=Pituus).Font.ColorIndex
solu.Offset(0, i) = a(i - 1)
solu.Offset(0, i).Characters(Start:=1).Font.ColorIndex = väri
Alku = Alku + Pituus + 1
Next
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
moduuliin...

Sub TekstiSiirto()
Dim vika As Integer
Dim a As Variant
On Error Resume Next
Application.ScreenUpdating = False
vika = Range("B65536").End(xlUp).Row
For Each solu In Range("B1:B" & vika)
a = Split(solu, " ") ' erottimena välilyönti
For i = 1 To UBound(a) + 1
solu.Copy
solu.Offset(0, i + 1).PasteSpecial Paste:=xlPasteFormats
solu.Offset(0, i + 1) = a(i - 1)
Next
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
jos haluat estää muotoilemasta asetuksia esikatselussa niin lisää FALSE esikatselu komennon perään
ActiveSheet.PrintPreview False

Tulostusalueen valinnan poisto oli ihan Ok lisäys. ;-)
tutustuppa Tiedot/lomake. Tekee just sen mitä kyselet.
muuta Ok-painikkeen Default arvo arvoksi TRUE. Oletuksena on FALSE
:-)
määritellään tulostusalue, jolloin ei tulosteta muuta kuin se alue.Tietenkin pitää pitää huolta, että mahtuu yhdelle sivulle

Sub EsikatsaTulosta()
Dim Viimeinenrivi As Integer
Application.ScreenUpdating = False
Viimeinenrivi = Range("B65536").End(xlUp).Row

ActiveSheet.PageSetup.PrintArea = "B2:K" & Viimeinenrivi
ActiveSheet.PrintPreview
Range("A1").Select
Application.ScreenUpdating = True
End Sub
viimeinenrivi palauttaa lukuarvon eikä tekstiä
muutin sen kanssa

Sub EsikatsaTulosta()
Dim Viimeinenrivi As Integer
Application.ScreenUpdating = False
Viimeinenrivi = Range("B65536").End(xlUp).Row
Range(Cells(2, 2), Cells(Viimeinenrivi + 1, 11)).Select
ActiveSheet.PrintPreview
Range("A1").Select
Application.ScreenUpdating = True

End Sub
Itse en ole toistaiseksi joutunut pahemmin turvautumaan VBA:han / makroihin. Mieluiten käytän yksinkertaisinta lähestymistapaa, eritoten jos muidenkin on tarkoitus käyttää taulukkoa... Keep it simple! :)

kun teet taulukon, jossa tarkastalet soluihin syötettyjä arvoja ja varmistelet, että vain oikeat arvot on syötetty ja teet virheilmoitukset käyttäjälle. Ei meinaan ole enää mitään simppeliä tavallisilla excelin kaavoilla...
ilmeiseti sun sovellutukset sen verran simppeleitä...
no tää nyt vähän offtopicina tähän yksinkertaiseen juttuun
kivahan se on kopioida kaavoja manuaalisesti ehkä tuhansiin riviin. Kumpi sitten helpompi/vaikeampi copy/paste moduuliin kerran vaiko kaavojen kopiointi....
TAULUKON moduuliin...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim vika As Integer
Dim vika2 As Integer
Dim Alue As Range
Dim i As Integer
On Error Resume Next
vika = Range("M65536").End(xlUp).Row
For i = 1 To vika
If Range("C" & i) = Range("M" & i) Then
Range("N" & i) = "Audi"
End If
If Range("G" & i) = Range("M" & i) Then
Range("N" & i) = "Volvo"
End If
Next
End Sub
tällä nyt vaikka alkuun

solu A10 teksti päiväys
solu b 10 teksti summa

maalaa solut A10 ja B10 ja kaavaruutuun kirjoitat tietokanta ja ENTER. Nyt pitäisi olla nimetty alue tietokanta
samoin tee esim.

solu H1 teksti lakun pvm
solu I1 teksti laskun summa

maalaa solut H2 ja I2 ja kaavaruutuun kirjoitat syöttöalue ja ENTER. Nyt pitäisi olla nimetty alue syöttöalue.

Jos ei onnistu noin niin tee lisäämällä nimi valikon kautta

lisää nappi yläriville (ennen riviä 10) ja liitä siihen makro UusiLasku

moduuliin...

Option Explicit
Sub UusiLasku()
Dim Rivi As Long
On Error GoTo virhe
If Range("Syöttö").Cells(1, 1) = "" Or _
Not OnkoPäiväys(Range("Syöttö").Cells(1, 1)) Then
Range("Syöttö").Cells(1, 1).Select
MsgBox "Anna päiväys! esim 12.2.2006 tai 12/6/2006", vbInformation
Exit Sub
End If
If Range("Syöttö").Cells(1, 2) = "" Or _
Not IsNumeric(Range("Syöttö").Cells(1, 2)) Then
Range("Syöttö").Cells(1, 2).Select
MsgBox "Anna summa!", vbInformation
Exit Sub
End If
With Range("Tietokanta") ' itse määritelty alue
Rivi = .Rows.Count + 1 'lisätään tietokantaan rivi
Range("Syöttö").Copy Destination:=.Cells(Rivi, 1) ' kopioidaan tiedot
.Resize(Rivi).Name = "Tietokanta" ' päivitetään tietokanta lisäyksen jälkeen
End With
Range("Tietokanta").Offset(Range("Tietokanta").Rows.Count) = ""
Range("A10").Offset(Range("Tietokanta").Rows.Count + 2, 0) = Range("Syöttö").Cells(1, 1)
Range("B10").Offset(Range("Tietokanta").Rows.Count + 2, 0).FormulaLocal = "=SUMMA(B10:B" & Range("Tietokanta").Rows(2).End(xlDown).Row & ")"
Range("Syöttö") = "" 'tyhjennetään syöttöalue
virhe:
End Sub

Function OnkoPäiväys(Pvm As String) As Boolean
Dim Päiväys As Date
On Error GoTo virhe
Päiväys = DateValue(Range("Syöttö").Cells(1, 1))
OnkoPäiväys = True
Exit Function
virhe:
OnkoPäiväys = False
End Function

nyt laskee automaattisesti summan yhden tyhjän rivin päähän viimeisestä laskusta( koska helpompi käsitellä asioita näin)
Voit aivan vapaasti poistaa rivejä välistä tai lopusta ja silti ohjelma toimii oikein!
Arvot syötetään H2 ja I2 ja sen jälkeen klikkaat nappia.
Lisäsin vielä tarkistukset tyhjille arvoille sekä tarkistukset, että on päiväys sekä luku
:-)
kuten arvelitkin ei Excelillä voi hakea toisesta solusta pelkkiä kaavoja- ainostaan kaavojen tuloksia.
VBA:lla asia on kuitenkin todella helppo tehdä. Pari tekstifunktiota ja tulosten yhdistäminen...

Tein nyt oman käyttäjän makron - liitä se moduuliin. Siihen soluun mihin haluat kaavan kopioituvan kirjoitat

=TeeKaava(E21;25)
missä Solu=E21 ja Siirtymä=25 (esimerkkisi mukaan), eli Solu on se solu, josta kaava kopioidaan(E21) ja Siirtymä(25) on siirtymä uudesta kaavasolusta. Kaava toimii vaikka vaihdat solunosoitetta esim.
Ruokapäiväkirja!D27--->Päiväkirja!D27

:-)

moduuliin...

Function TeeKaava(Solu As Range, Siirtymä As Integer) As String
Dim teksti As String
Dim eka As Integer
Dim toka As Integer
Dim osoite As String
Dim osoite1 As String
Dim osoite2 As String
Dim siirto As Integer
On Error Resume Next
Application.Volatile
teksti = Solu.FormulaLocal

eka = InStr(1, teksti, "!")
toka = InStr(1, teksti, ";")
'alkuperäinen offsetsolu
osoite1 = Mid(teksti, eka + 1, toka - eka - 1)

eka = toka + 1
toka = InStr(eka, teksti, ";")
siirto = Mid(teksti, eka, toka - eka)
'uusi offsetsolu
osoite = Range(osoite1).Offset(siirto, 0).Address

eka = InStr(1, teksti, "(")
toka = InStr(1, teksti, "!")
'alkuperäinen offsetsolu
osoite2 = Mid(teksti, eka + 1, toka - eka)

TeeKaava = "=SIIRTYMÄ(" & osoite2 & osoite & ";" & Siirtymä & ";0;1;1)"
End Function
tee kirjainmerkki Alku dokumentin alkuun ja sivun loppuihin lisäät Gotobutton kentän ja siihen kirjainmerkiksi Alku ja näytä tekstiksi vaikka Alkuun. Tuplaklikkaamalla siirtyy sitten dokumentin alkuun.
mutta kysymyksesi liian yleinen.
Haetaanko samasta työkirjasta, toisesta avoimesta vai suljetusta työkirjasta.
Mistä hakutiedot saadaan?
siirretäänkö koko rivin tiedot vai osa tietoja jne...

asiasta keskusteltu allaolevissa linkeissä

http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000018689094

http://keskustelu.suomi24.fi/show.fcgi?category=108&conference=4500000000000708&posting=22000000017181332
69 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt