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
393
Vastaukset 9
- 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
Onko vassarin lääkkeet(mt) jääneet taas ottamatta
Sen verran järjetöntä persuhuutoa taa näkyville. Tuo yksi häiriintynyt ei osaa kuin "huutaa" isoilla kirjaimilla, se on471492Olen nainen pahoillani, että tykkään sinusta niin paljon, että
Haluaisin panna sua. Tuntuu vaan siltä, että olet sen suhteen ihan haluton. Ei minulle riitä pelkkä ystävyyssuhde.59890Mieti oikeasti
Ollaan lähes tuntemattomia, mutta samalla on tämä erityinen vuosien tilanne takana, joka on ollut monella tapaa väärin.30667- 87637
kene ajoi "kolarin"?
"Punkaharjulla Luston ja Tuppuranmäen välillä sattui tiistaina aamupäivällä liikenneonnettomuus. Poliisin mukaan Savonl14605- 43573
Pahin tapa satuttaa toista
On jättää toinen vaille mitään vastausta. Erityisen kipeää se tekee sillon jos toinen ghostaa.56564- 7542
Puukotus Kajaanissa
Kuka puukotti ja ketä? https://yle.fi/a/74-20247765 Vähemmän yllättäen päihteet mainittu24531- 44521
Alkaa jotenkin nyt kuvio hahmottuu täällä
Sellainen vaikutelma tästä alkaa tulla, että täällä on joku pieni porukka, joka tuntee toisensa tai ainakin pelaa samaan70520- 61515
Jos kaivattusi on
Varattu niin miksi et antaisi asian olla hänen suhteen. Miksi ylipäätään vielä jatkat?47513- 37496
Minulla on joskus ikävä sinua ja ajattelen sinua joskus.. edelleen
Olin joskus niin rakastunut sinuun. Olin onnellinen, että kohdattiin ja kun vain tiesin sinun olevan olemassa. Täytit aj14491Kylän tielle remonttia?
Mitäköhän kylän tielle ruvetaan tekemään ku laitettu tuommoset töpsät muutamien suojateitten kohille?13472Hyvä on sitten, jos et sitä s*ksiä halua kanssani.
Rakastetaan vaan toisiamme, voin käydä muualla tyydyttämässä fyysisenpuolen tarpeet. Puhumalla tämäkin olisi selvinnyt.132449- 42418
Nainen, tässä olen kahden vaiheilla
Toinen pitäisi valita ja kummassakin on hyvät ja huonot puolensa. Toinen olisi sellainen pysyvä mutta työläs. Toinen taa45409Miten vuosien jälkeenkin tunteet voivat olla niin voimakkaat?
Että pelkkä ajatus sinusta täyttää silmät kyynelistä.26399