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
- just niinhän koodi tekee ;-)
Keep EXCELing
@Kunde - Varmaan moni ihmettelee tota koodiani ja sen logiikkaa...
Excelissä ehdollinen muotoilu priorisoi solussa olevat "normaalit" muotoilut ja sitä käytetään hyväksi. Koodi muuttaa Rivinumeron arvon aina aktiivisen solun rivinumeroksi ja jos solun ehdollinen muotoilu =(RIVI()=Rivinumero ) toteutuu, se ylikirjoittaa solussa olevan normimuotoilun ehdon mukaisesti ja jos ehto ei toteudu, niin mitään ei tapahdu ;-)
Keep EXCELing
@Kunde - 1. Valikosta Kaavat/Nimien hallinta/Uusi...
Nimi= Rivinumero
Viittaus=0 ja Ok ja Sulje
2. Valitse solualue tai koko taulukko ja tee ehdollinen oma muotoilu. Kaavana käytä
=(RIVI()=Rivinumero ) ja määrittele muotoilut...
3. Kopioi postaamani koodinpätkä. Alhaalta tilariviltä klikkaa taulukon nimeä hiiren oikealla ja valikosta valitse Näytä koodi. Liitä oikealla olevaan valkeaan tilaan koodi. Tallenna työkirja ja naati!
Keep EXCELing
@Kunde - jos muotoiluja soluissa ja ne halutaan säilyttää,niin silloin ...
1. Lisää Nimi esim. Rivinumero ja sille viitaus =0
2. Lisää solualueelle tai vaihtoehtoisesti koko taulukolle haluamasi solumuotoilu ja sille ehto
=(RIVI()=Rivinumero )
ko taulukon moduuliin...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Names("Rivinumero").RefersTo = "=" & Target.Row
End Sub
Keep EXCELing
@Kunde - Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Cells.Interior.ColorIndex = 0
Target.EntireRow.Interior.ColorIndex = 8
' jos haluat myös sarakkeen korostuvan poista allaolevalta riviltä hipsu
'Target.EntireColumn.Interior.ColorIndex = 8
End Sub
Keep EXCELing
@Kunde - C`mon vastaajat kysyjähän halusi tietää versiosta 2003 eikä uusimmista ;-)
Ei ole mulla enään 2003 versiota millään koneella ;-( , joten en voi auttaa, mutta kyllä se aikanaan toimi... - Ei ole mahdollista.
Mutta kikkailemalla kirjoittamalla kaikki tekstit yhteen noista sarakkeista ja muotoilemalla onnistuu jotenkuten. Tietenkin jos tekstit vaihtelee sarakkeissa(pituus) niin muotoilla pitää enemmän, mutta toisaalta esim. makrossa ennen tulostusta tai tallennusta noita muotoiluja helppo tehdä...
Keep EXCELing
@Kunde - Välillä ihmetyttää nää helpompi jutut, jos kysytään niin vastaan pyyntöön.
Tottakai sen voi tehdä monella tapaa ja monestikin kysymyksestä ei edes selviä tarkoituskaan vaan pitää arvailla.
Vaihtoehtoinen_tapa vaan olettaa, että helpompi... ;-) - moduuliin...
muuta sarake ja aloitusrivi sopivaksi- nyt A sarake ja etsii ekan tyhjän alkaen A1 solusta
Sub Summa()
Dim Vika As Long
Vika = Range("A1").End(xlDown).Row
Range("A" & Vika 1) = WorksheetFunction.Sum(Range("A1:A" & Vika))
End Sub
Keep EXCEling
@Kunde - jompikumpi ThisWorkbook moduuliin...
lisätty esikatselu tulostukselle
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim Muotoilu
Dim Väri
Dim x
On Error GoTo Virhe
If ActiveSheet.Name = "Taul1" Then
Application.EnableEvents = False
Cancel = True
Muotoilu = Range("E5").NumberFormat
Väri = Range("E5").Interior.Color
Range("E5:IJ5,E7:IJ7,E9:IJ9").Interior.Pattern = xlNone
Range("E5:IJ5,E7:IJ7,E9:IJ9").NumberFormat = ";;;"
ActiveSheet.PrintPreview
x = MsgBox("Tulostetaanko?", vbInformation vbYesNo)
If x = 6 Then
ActiveSheet.PrintOut
End If
Range("E5:IJ5,E7:IJ7,E9:IJ9").NumberFormat = Muotoilu
Range("E5:IJ5,E7:IJ7,E9:IJ9").Interior.Color = Väri
Virhe:
Application.EnableEvents = True
Cancel = True
End If
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error GoTo Virhe
If ActiveSheet.Name = "Taul1" Then
Application.EnableEvents = False
Range("E5,E7,E9").EntireRow.Hidden = True
ActiveSheet.PrintPreview
x = MsgBox("Tulostetaanko?", vbInformation vbYesNo)
If x = 6 Then
ActiveSheet.PrintOut
End If
Range("E5,E7,E9").EntireRow.Hidden = False
Virhe:
Application.EnableEvents = True
Cancel = True
End If
End Sub
Keep EXCELing
@Kunde - Private Sub Workbook_BeforePrint(Cancel As Boolean) koodi pitää olla ThisWorkbook moduulissa, jotta toimii
- ThisWorkbook moduuliin...
jompikumpi, mutta ei molempia!
jos haluat parittomat rivit jäävät näkyviin, niin tää
Private Sub Workbook_BeforePrint2(Cancel As Boolean)
Dim Muotoilu
Dim Väri
On Error GoTo Virhe
If ActiveSheet.Name = "Sheet1" Then
Application.EnableEvents = False
Cancel = True
Muotoilu = Range("E5").NumberFormat
Väri = Range("E5").Interior.Color
Range("E5:IJ5,E7:IJ7,E9:IJ9").Interior.Pattern = xlNone
Range("E5:IJ5,E7:IJ7,E9:IJ9").NumberFormat = ";;;"
ActiveSheet.PrintOut
Range("E5:IJ5,E7:IJ7,E9:IJ9").NumberFormat = Muotoilu
Range("E5:IJ5,E7:IJ7,E9:IJ9").Interior.Color = Väri
Virhe:
Application.EnableEvents = True
Cancel = True
End If
End Sub
jos haluat parittomat rivit piiloon, niin tää sitten, mutta ei kuiteskaa molempia koodeja voi olla yhtäaikaa!
Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error GoTo Virhe
If ActiveSheet.Name = "Sheet1" Then
Application.EnableEvents = False
Cancel = True
Range("E5,E7,E9").EntireRow.Hidden = True
ActiveSheet.PrintOut
Range("E5,E7,E9").EntireRow.Hidden = False
Virhe:
Application.EnableEvents = True
End If
End Sub
lisääja muuttele tarvittavat solut koodiin
Keep EXCEling
@Kunde - Koodeissa vaihdat
A1--->A2
B1--->B2
C1--->C2
D1--->D2
E1--->E2
ei muuta tartte tehdä...
Keep EXCELing
@Kunde - lh3ggggeggeee lisää sä vaan käsin...
- toimii just ihan oikein, mutta et ole lisännyt koodiin kuin yhteen kohtaan & " " & Worksheets("Taul2").Range("D1") & "- " & Worksheets("Taul2").Range("E1")
eli jos ei ole kommenttia niin toimii ok ja sen jälkeen vaan lisää VK, koska et ole lisännyt D ja E solun tietoja koodiin...
2 kohtaan toi rimpsu pitää lisätä vielä ;-)
Keep EXCEling
@Kunde - helpompi tapa...
taulukkovalitsimesta alhaalla tilarivillä hiiren oikealla klikkaa taulukkoa ja avautuvasta valikosta näytä koodi ja liitä koodi sitten oikealle tyhjään tilaan... - voit ne lisätä koodiin juuri noin, mutta kun solussa C1 on jo se VK 1-20 tieto ja se siirtyy koodilla.
Miksi haluat vielä lisätä sinne 1 20???
toi =VK&" "&D1&"-"&E1 siis TAUL2 soluun C1 ja muokkaat sitten niitä TAUL2 soluja D1 ja E1
jos sulla on TAUL2 solussa C1= VK JA TAUL2 solussa D1=1 ja TAUL2 solussa E1=20
ja haluat ne kommenttiin lisätä niin sitten
solu.Comment.Text Hakuehto & ":" & vbNewLine & Worksheets("Taul2").Range("B1") & " " & Worksheets("Taul2").Range("C1")
& " " & Worksheets("Taul2").Range("D1") & "- " & Worksheets("Taul2").Range("E1")
Keep EXCELing
@Kunde - No eihän sun tartte muuta tehdä kuin C1 laitat kaavan ???
=VK&" "&D1&"-"&E1
koodihan siirtää sen C1 tiedot kommenttiin
Keep EXCELing
@Kunde - Kyllähän koodissa menee nytkin jo tieto C1 solusta...
pitääkö se nyt vielä pilkko eri riville kommentissa? - siis haluat Taul2 C1 tiedon soluihin C1:E1
mitä yritit koodissa menisi Taul1:ssä henkilön kommenttiin... ;-)
en tiedä mitä koodeja sulla käytössä, joten vaikea neuvoa
no vaikka näin...
Sub pilko()
Dim a
Dim b
a = Split(Range("C1"), " ")
b = Split(a(1), "-")
Range("C1")= a(0)
Range("D1")= b(0)
Range("E1")=b(1)
End Sub
Keep EXCELing
@Kunde