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
331
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
Vuonna 2026 jää entistä vähemmän rahaa käteen palkansaajille
Työttömyysvakuutusmaksu nousee 0,3 prosenttia. Työeläkemaksu nousee 7,15 prosentista 7,3 prosenttiin. Työmarkkinajärjest636023Yritystuet pois ja työeläkevaroilla maksettava valtion velka pois
Nyt on teille kerrottu keino kuinka Suomen velkaongelmasta päästää eroon kertalaakista. Älkää saatanat enää minulle tul1155314Suomen kansa puhunut: Purra huonoimpia ministereitä
Kouluarvosanalla 6–, eli samaa tasoa mitä Purran oikeakin koulutodistus. Epäpätevyys on tullut huomattua Suomen talouden3944193Aleksei Miltsakov - venäläinen uusnatsi antaa oppitunteja lapsille
34-vuotias Miltsakov palvelee Le Monden mukaan yhä Ukrainassa tiedusteluun ja sabotaasiin erikoistuneen Russitš-yksikön473520Ylen juttu sisäministeristä oli selvän tarkoitushakuinen
haluttiin vielä vuoden loppuun saada joku "kohu". (Olisiko Yle tehnyt jutun jos sisäministerinä olisi esim. RKP:n, jota1483344Suomalaista yrittäjää ei kommunistista erota
Muualla maailmassa yrittäjät elävät asiakkaiden rahoilla, Suomessa palkansaajien maksamilla veroilla. Palkansaajahan ma612830Joulun ruokajonoissa entistä enemmän avuntarvitsijoita - Mitä ajatuksia tämä herättää?
Räppärit Mikael Gabriel, VilleGalle ja Jare Brand jakoivat ruokaa ja pehmeitäkin paketteja vähävaraisille jouluaattoa ed1332171- 272170
Pyydän anteeksi etten osannut ratkaista
Mitään muuta kuin lähtemällä. Et oikein tullut vastaan etkä kuunnellut. Tuntui että minun piti koittaa sopia ja sovitell851979Ulkoministeriön konsulipäällikkö arvostelee rajusti Haavistoa: "Täällä on pelon ilmapiiri"
"– Täällä on ministerin toimien takia aivan selvästi pelon ilmapiiri. Jos sellaisen annetaan pesiytyä virkamieskulttuuri191970