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
330
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
Suomen kansa haluaa Antti Lindtmanista pääministerin
Lindtman on miltei tuplasti suositumpi kuin etunimikaimansa Kaikkonen. Näin kertoo porvarimedian teettämä kysely. http3024869Vain 21% kannattaa Lindtmania pääministeriksi
se on selvästi vähemmän kuin puolueen kannatus, mites nyt noin?1383109Miksei Björn Wahlroos jaa rahaa köyhille?
Esimerkiksi Nordean tiloissa? Vai tuovatko ne köyhät hiekkaa marmorilattioille ja siksi ei pysty mursunviiksi pystyyn k683085Jouluksi miettimistä: kuka tai mikä valmistaa rahan?
Nyt kun on ollut vääntöä rahasta ja eritoten sen vähyydestä, niin olisi syytä uida rahan alkulähteille, eli mistä se syn331590Julkinen sektori on elänyt aivan liian leveästi yli varojensa!
Viimeisen 15 vuoden aikana julkisen puolen palkat ovat nousseet n. 40%, kun taas yksitysellä sektorilla vain n. 20%. En2271282- 471219
Yksikään persu ei ole saanut Nobelin palkintoa
Kertoo paljon persujen älyn puutteesta. Demareista mm. Ahtisaari on kyseisen palkinnon saanut.151058Miten antaa merkki hyvin eri ikäiselle miehelle, että kertoisi toiveensa ja ajatuksensa?
Olen pitkään pitänyt miehestä, joka myös varmasti minusta. Hän ei tosin kerro ihastumisesta, eli voi hyvin olla, että tu791047Paskalaista valokuitulakiin
Nyt maksajiksi joutuvat kaupunkilaiset eivätkä mökkiensä ulkohuusseissa kakistelevat mummot. Nimittäin EU määrää jokais521019Emme koskaan keskustelleet kasvotusten syistä välirikollemme
Enkä voisi kertoa perimmäistä rehellistä syytä. Kerroin sinulle pintapuolisen ”paketin” ja otin tavallaan omalle vastuu581011