Työkirjan välilehdellä Taul1 on toistasataa riviä ja osa riveistä on lihavoitu. Kaikkien rivien sarakkeessa A on tekstiä.
Välilehdelle Taul2 haluaisin ainoastaan ne rivit, jotka ovat lihavoitu.
Kuinka tämä onnistuisi? Varmaankin makrolla, mutta millaisella sisällöllä?
lihavoidut rivit toiselle välilehdelle
Jarim90
9
354
Vastaukset
- jarim90
ja käytössä on Excel 2007.
moduuliin...
muuta taulukonnimi sopivaksi
Sub Siirrä()
Dim vika As Long
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A1:A" & vika)
If solu.Font.Bold = True Then
solu.EntireRow.Copy Worksheets("Taul2").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
End Sub
Keep EXCELing
@Kunde
- Jarim90
Mahtavaa, kiitos tuosta Kunde.
Sitten olisi vielä toinen ongelmatapaus, jossa pitäisi siirtää välilehdeltä TARKAT tietoja välilehdelle KOONTI. Tämä onnistui aluksi ihan manuaalisesti kopioi-liitä toiminnolla, mutta nyt on alkanut tietomäärät paisumaan, joten siirtyisin tässäkin mieluusti makroon.
Välilehti KOONTI: sarakkeessa C otsikot ja sarakkeessa D summat.
Välilehti TARKAT: sarakkeessa A otsikot (lihavoituna). Samassa sarakkeessa on myös muita tietoja, mutta nämä eivät ole lihavoituja. Välilehden ”viimeisessä” sarakkeessa on yhteensäsummat. ”Viimeinen” sarake on ns. liikkuva eli kun yksi viikko tulee taulukkoon lisää, niin viimeinen sarake siirtyy tällöin yhden oikealle. ”Viimeisen” sarakkeen ainut pysyvä tieto on rivillä 2 löytyvä tieto ”Yhteensä”.
VAIHE 1
Vertaa löytyykö välilehden TARKAT sarakkeesta A lihavoitua otsikkoa joka vastaisi välilehden KOONTI sarakkeen C otsikkoa. Mikäli vastaavuus löytyy, niin tällöin siirtyy vaiheeseen 2. Mikäli vastaavuutta ei välilehdeltä KOONTI löydy, niin tällöin kopioi välilehdeltä TARKAT sarakkeesta A tiedon ja liittää sen välilehden KOONTI ensimmäiselle tyhjälle riville sarakkeeseen C. Makro ei siis saisi kopioida lihavoimattomia otsikkotietoja vaan vertaa ainoastaan välilehdeltä TARKAT löytyviä lihavoituja väliotsikkotietoja välilehden KOONTI tietoihin.
VAIHE 2
Vertaa löytyykö välilehden TARKAT sarakkeesta A otsikkoa joka vastaisi välilehden KOONTI sarakkeen C otsikkoa ja kopioi välilehden TARKAT kyseisellä rivillä viimeisen tietoa sisältävän solun sisällön ja liittää sen välilehden KOONTI sarakkeeseen D sille riville, josta vastaavuus löytyi.
Kiitos jo etukäteen!Sub Siirrä()
Dim vika As Long
Dim löydetty As Range
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A1:A" & vika)
If solu.Font.Bold = True Then
Set löydetty = EtsiJaSiirrä(solu)
If Not löydetty Is Nothing Then
solu.End(xlToRight).Copy Worksheets("KOONTI").Range(löydetty.Address).Offset(0, 1)
Else
solu.Copy Worksheets("KOONTI").Range("C65536").End(xlUp).Offset(1, 0)
End If
End If
Next
End Sub
Function EtsiJaSiirrä(Hakuehto As Variant) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("KOONTI").Activate
With Range("C:C")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Keep EXCELing
@Kunde
- Jarim90
Melkein toimii. Tällä hetkellä tuo välilehden KOONTI sarakkeeseen C ihan oikein TARKAT välilehden sarakkeesta A lihavoidut otsikot, mutta sarakkeeseen D tulee vain TARKAT välilehden solusta B2 tieto 201011.
Alla lueteltuna mitä tietoa välilehdellä TARKAT on nyt:
A1 = Tieto "Tunnit yhteensä"
A2 = tyhjä solu
A3 = Tieto "Row Labels"
A4:A65 = otsikoita (lihavoituja) ja henkilöiden nimiä (ei lihavoitu)
A66 = Tieto "Yhteensä" (lihavoitu)
B1 = Tieto "Column Labels"
B2 = Tieto "201011" (osoittaa siis vuotta ja kuukautta)
B3 = Tieto "46" (osoittaa siis viikkoa)
B4:B65 = tuntimäärät otsikoittain (lihavoitu) sekä henkilöittäin
B66 = sarakkeen kaikki tuntimäärät yhteensä eli viikon 46 tunnit
C1:C2 = tyhjät solut
C3 = Tieto "47" (osoittaa viikkoa)
C4:C65 = tuntimäärät otsikoittain (lihavoitu) sekä henkilöittäin
C66 = sarakkeen kaikki tuntimäärät yhteensä eli viikon 47 tunnit
D1 = tyhjä solu
D2 = Tieto "201012 (osoittaa siis vuotta ja kuukautta)
D3 = Tiet0 "48" (osoittaa siis viikkoa)
D4:D65 = tuntimäärät otsikoittain (lihavoitu) sekä henkilöittäin
D66 = sarakkeen kaikki tuntimäärät yhteensä eli viikon 48 tunnit
....
X sarake = viikon 16 tiedot
Y1 = tyhjä solu
Y2 = Tieto "Yhteensä" (lihavoitu)
Y3 = tyhjä solu
Y4:Y65 = sarakkeiden B:X summat rivikohtaisesti
Y66 = sarakkeen kaikki tuntimäärät yhteensä eli kaikkien viikkojen tunnit
Z sarakkeesta eteenpäin = tyhjiä soluja
Makron pitäisi siis poimia summatiedot nyt sarakkeesta Y, mutta kun ensi viikolla on väliin tullut viikon 17 tiedot niin tällöin sarakkeesta Z eli tällä tarkoitin tuon edellisen viestini kohtaa VAIHE 2, jossa summatieto pitäisi siirtää viimeiseltä tietoa sisältävältä sarakkeelta. - Jarim90
Lisätietona, että kun suoritin makron uudelleen eli kaksi kertaa peräkkäin niin tällöin välilehdelle KOONTI tuli myös muita tietoja sarakkeeseen D.
Soluun D2 tuli tieto "Column Labels" (TARKAT välilehden rivin 1 viimeinen tieto)
Soluun D3 tuli tieto "16" (TARKAT välilehden rivin 3 viimeinen tieto)
Soluihin D4:D27 tuli välilehdeltä TARKAT kunkin lihavoidulla otsikolla varustetun rivin ensimmäinen tieto.
Soluun D28 tuli tieto "393" (TARKAT välilehden Y66 solusta tieto eli kaikkien viikkojen yhteensä tuntimäärä.
Soluun D29 tuli tieto "201011" eli TARKAT välilehden solusta B2. eihän se voikaan toimia jos tiedot on erilailla kuin koodissani oletin kuvauksen perusteella...
helppohan tota nyt on muutella sopivaksi...
En nyt ymmärrä miksi, jos vastaavaa tietoa ei löydy niin siirretään vaan pelkkä ostikko? Nythän joutuu makron ajamaan 2 kertaa, jotta tieto siirtyy oikein (asia han ei minulle kuulu, mutta...)
Sub Siirrä()
Dim vika As Long
Dim löydetty As Range
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A4:A" & vika - 1)
If solu.Font.Bold = True Then
Set löydetty = EtsiJaSiirrä(solu)
If Not löydetty Is Nothing Then
Worksheets("TARKAT").Cells(solu.Row, 256).End(xlToLeft).Copy
Worksheets("KOONTI").Range(löydetty.Address).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
Else
solu.Copy Worksheets("KOONTI").Range("C65536").End(xlUp).Offset(1, 0)
End If
End If
Next
End Sub
Function EtsiJaSiirrä(Hakuehto As Variant) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("KOONTI").Activate
With Range("C:C")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function
Keep EXCELing
@Kundejos nyt sitten haluat sen Yhteensä kentänkin sinne siirtää niin...
Sub Siirrä()
Dim vika As Long
Dim löydetty As Range
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A4:A" & vika) ' siirtää Yhteensä kentän
'For Each solu In Range("A4:A" & vika - 1)' ei siirrä Yhteensä kenttää
If solu.Font.Bold = True Then
Set löydetty = EtsiJaSiirrä(solu)
If Not löydetty Is Nothing Then
Worksheets("TARKAT").Cells(solu.Row, 256).End(xlToLeft).Copy
Worksheets("KOONTI").Range(löydetty.Address).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
Else
solu.Copy Worksheets("KOONTI").Range("C65536").End(xlUp).Offset(1, 0)
End If
End If
Next
End Sub
Function EtsiJaSiirrä(Hakuehto As Variant) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("KOONTI").Activate
With Range("C:C")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function- Jarim90
"En nyt ymmärrä miksi, jos vastaavaa tietoa ei löydy niin siirretään vaan pelkkä ostikko? Nythän joutuu makron ajamaan 2 kertaa, jotta tieto siirtyy oikein (asia han ei minulle kuulu, mutta...)"
Niin, ajattelin tuon vaiheistuksen tuohon laittaa, että jos ensiksi makro tsekkaisi löytyykö kaikki TARKAT välilehden lihavoidut otsikot välilehdeltä KOONTI ja jos ei niin ensiksi se lisäisi ne sinne ja tämän jälkeen toisi vasta yhteensä luvut otsikoille. Kaikki olisi helpompaa, jos TARKAT välilehden tietoihin tuotaisiin aina vain uuden viikon tiedot, mutta nyt järjestelmästä tulee koko välilehden tiedot eli korvaa aina vanhat tiedot. Tällöin riveillä olevien otsikoiden järjestykset yms. voi muuttua ja siksi tarvittiin tuolle KOONTI välilehdelle tuoda noita tietoja. Pelkkää otsikkoahan ei periaatteessa tuoda, sillä jos TARKAT välilehdellä on otsikko niin tällöin siellä on myös yhteensä luku.
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Riikka ei suostu laskemaan bensan hintaa
Sanna laski esimerkiksi sähkön arvonlisäveron 10 prosenttiin, jonka Riiikka anosti 25,5 prosenttiin. Sannan aikaan bens1583720Maahanmuuttajien vaikutus Suomen valtiontalouteen positiivinen
Maahanmuuttajat maksavat enemmän tuloveroja kuin saavat tulonsiirtoja. Eroavat persuista tässä suhteessa. Persuista o133023EK: Suomi tarvitsee vuosittain 45 000 maahanmuuttajaa
Senpä takia Riikkakin laulaa sen lauluja kenen leipää syö. Viime vuonnahan Suomeen muutti 50 tuhatta ulkomaalaista. htt2252622Kesäaika on normaaliaika...
...siten illalla on valoisaa tunnin pitempään, on sitten kesä tai talvi. Voi nauttia päivän jatkumisesta. Kuka nyt aamul2342101Uusin tutkimus: Suomi on maailman toiseksi vähin rasistinen maa
taakse jää mm. Ruotsi(7) ja Norja(8). Martin Paasi(kok.): Kumoaa vasemmiston väitteet. Kansainvälinen vertailu osoitta731900Ähtärin päättäjät
Nyt tulee kutsu leivättömän pöydän äärelle. Syytteet nostetaan. https://www.iltalehti.fi/kotimaa/a/cef83309-0a1b-4fcd-9b531307Ketkä 8 Ähtärin luottamushenkilöä saivat syytteen virka_aseman väärinkäyttämisestä?
Nyt näiden valtuutettujen nimet esiin, kiitos! Nämä henkilöt pitää yksinkertaisesti laittaa syrjään Ähtärin kaupunginva251209Tulen hulluksi hänestä
Hän on vanha ja varattu. Mutta olen ihan hulluna häneen. Haluan hänet omakseni. Haluan olla hänen kanssaan ajasta ikuisu701128Ensimmäinen kuukausi palkatatta
Siis ei jumankauta näitä kokoomuksen ehdoituksia. Nytkin joku Otto Meri ehdoittaa, että ensimmäinen kuukausi pitäisi ty87919- 109909