Sain tämän makron Kundelta ja silloin se tuntui toimivan pienellä muutoksella poistin silloin kohdan "SearchFormat:=False" koska makro herjasi siitä, mutta nyt ilmeni uusi ongelma se ei kopioi kuin erä 2 asti jonka jälkeen ei enää kopiointi toimi.
Tuli nyt vasta eteen kun vuoden vaihde lähestyy ja ajattelin ottaa makron käyttöön.
Sub Kopioi()
Dim Vika As Integer
Dim Haettava As Range
Dim Haettava2 As Range
Dim Hakualue As Range
Dim Löydetty As Range
Dim EkaSolu As String
Sheets("Syöttö").Activate
Set Haettava = Range("M9")
Set Haettava2 = Range("O6")
Sheets("Data").Activate
Vika = Range("B65536").End(xlUp).Row
Set Hakualue = Range("B1:B" & Vika)
Range("B1").Select
Set Löydetty = Hakualue.Find(What:=Haettava, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not Löydetty Is Nothing Then
EkaSolu = Löydetty.Address
If Löydetty.Offset(0, 3) = Haettava2 Then
MsgBox "Tiedot on jo olemassa", vbInformation
Exit Sub
Else
Do
Set Löydetty = Hakualue.FindNext(Löydetty)
If Löydetty.Offset(0, 3) = Haettava2 Then
MsgBox "Tiedot on jo olemassa", vbInformation
Exit Sub
End If
Loop While Not Löydetty Is Nothing And Löydetty.Address EkaSolu
Range("B" & Vika 1) = Haettava
Range("B" & Vika 1).Offset(0, 3) = Haettava2
End If
End If
End Sub
11_03_2006 kysytty
8
468
Vastaukset
- epäonnistui
Saakohan tähän mitään neuvoa??
- epäonnistui
Vai onko minussa vika? =)
Olisi mukavaa tietää miksi jouduin poistamaan SearchFormat:=False ja aluksi se tuntui toimivan ainakin erä 2 asti en ole varma koetinko silloin suurempaa erää. - epäonnistui
Asia korjantui "SearchFormat:=False" osalta kun otin uudemman excelin käyttöön Excel 2003, mutta siltin se lopettaa erä 2 kohdalla?
- epäonnistui
Nyt toimii tämä niin kuin pitääkin mutta vikana on vuodenvaihtuminen, elikä se ei huoli uutta vuotta ja erien alkamista alusta.
epäonnistui kirjoitti:
Nyt toimii tämä niin kuin pitääkin mutta vikana on vuodenvaihtuminen, elikä se ei huoli uutta vuotta ja erien alkamista alusta.
sorry, etten ollut huomannut aikaisemmin kyselyäsi...
tässä korjattu versio ;-)
Sub Kopioi()
Dim Vika As Integer
Dim Haettava As Range
Dim Haettava2 As Range
Dim Hakualue As Range
Dim Löydetty As Range
Dim EkaSolu As String
Sheets("Syöttö").Activate
Set Haettava = Range("M9")
Set Haettava2 = Range("O6")
Sheets("Data").Activate
Vika = Range("B65536").End(xlUp).Row
Set Hakualue = Range("B1:B" & Vika)
Range("B1").Select
Set Löydetty = Hakualue.Find(What:=Haettava, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False)
If Not Löydetty Is Nothing Then
EkaSolu = Löydetty.Address
If Löydetty.Offset(0, 3) = Haettava2 Then
MsgBox "Tiedot on jo olemassa", vbInformation
Exit Sub
Else
Do
Set Löydetty = Hakualue.FindNext(Löydetty)
If Löydetty.Offset(0, 3) = Haettava2 Then
MsgBox "Tiedot on jo olemassa", vbInformation
Exit Sub
End If
Loop While Not Löydetty Is Nothing And Löydetty.Address EkaSolu
Range("B" & Vika 1) = Haettava
Range("B" & Vika 1).Offset(0, 3) = Haettava2
End If
Else
Range("B" & Vika 1) = Haettava
Range("B" & Vika 1).Offset(0, 3) = Haettava2
End If
End Sub- kyselijä
kunde kirjoitti:
sorry, etten ollut huomannut aikaisemmin kyselyäsi...
tässä korjattu versio ;-)
Sub Kopioi()
Dim Vika As Integer
Dim Haettava As Range
Dim Haettava2 As Range
Dim Hakualue As Range
Dim Löydetty As Range
Dim EkaSolu As String
Sheets("Syöttö").Activate
Set Haettava = Range("M9")
Set Haettava2 = Range("O6")
Sheets("Data").Activate
Vika = Range("B65536").End(xlUp).Row
Set Hakualue = Range("B1:B" & Vika)
Range("B1").Select
Set Löydetty = Hakualue.Find(What:=Haettava, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False)
If Not Löydetty Is Nothing Then
EkaSolu = Löydetty.Address
If Löydetty.Offset(0, 3) = Haettava2 Then
MsgBox "Tiedot on jo olemassa", vbInformation
Exit Sub
Else
Do
Set Löydetty = Hakualue.FindNext(Löydetty)
If Löydetty.Offset(0, 3) = Haettava2 Then
MsgBox "Tiedot on jo olemassa", vbInformation
Exit Sub
End If
Loop While Not Löydetty Is Nothing And Löydetty.Address EkaSolu
Range("B" & Vika 1) = Haettava
Range("B" & Vika 1).Offset(0, 3) = Haettava2
End If
Else
Range("B" & Vika 1) = Haettava
Range("B" & Vika 1).Offset(0, 3) = Haettava2
End If
End SubMinulla on siinä syöttö taulussa enemmänkin tietoa miten nämä saadaan makroon?
Function tallennatiedot(paikka)
Set Data = Sheets("Data").Range("A2")
Set Data = Data.Offset(paikka, 0)
Sheets("Data").Rows(paikka 2).ClearContents' pistetaan tietoa
With ActiveSheet
Data.Offset(0, 1) = .Range("O6") ' Erä
Data.Offset(0, 2) = .Range("M9") ' Vuosi
Data.Offset(0, 3) = .Range("D9")
Data.Offset(0, 4) = .Range("I9")
Data.Offset(0, 5) = .Range("A13")
Data.Offset(0, 6) = .Range("I13")
Data.Offset(0, 7) = .Range("L16")
Data.Offset(0, 8) = .Range("L17")
Data.Offset(0, 9) = .Range("M16")
jne..... kyselijä kirjoitti:
Minulla on siinä syöttö taulussa enemmänkin tietoa miten nämä saadaan makroon?
Function tallennatiedot(paikka)
Set Data = Sheets("Data").Range("A2")
Set Data = Data.Offset(paikka, 0)
Sheets("Data").Rows(paikka 2).ClearContents' pistetaan tietoa
With ActiveSheet
Data.Offset(0, 1) = .Range("O6") ' Erä
Data.Offset(0, 2) = .Range("M9") ' Vuosi
Data.Offset(0, 3) = .Range("D9")
Data.Offset(0, 4) = .Range("I9")
Data.Offset(0, 5) = .Range("A13")
Data.Offset(0, 6) = .Range("I13")
Data.Offset(0, 7) = .Range("L16")
Data.Offset(0, 8) = .Range("L17")
Data.Offset(0, 9) = .Range("M16")
jne.....Nythän koodi hakee B sarakkeesta vuosilukua ja erää ja jos ei löydy niin tekee uuden rivin.
eli
Range("B" & Vika 1) = Haettava ’M9 ja se tulee B sarakkeeseen
Range("B" & Vika 1).Offset(0, 3) = Haettava2 ’O6 ja se tulee E sarakkeeseen
Range("B" & Vika 1).Offset(0, 4) = Sheets("Syöttö").Range("D9") ja se tulee E sarakkeeseen
jne...
offset on 0 pohjainen joten
Range("B" & Vika 1).Offset(0, 0) on sama solu kuin Range("B" & Vika 1)
Range("B10").Offset(1, 3)=E11
jne...- kyselijä
kunde kirjoitti:
Nythän koodi hakee B sarakkeesta vuosilukua ja erää ja jos ei löydy niin tekee uuden rivin.
eli
Range("B" & Vika 1) = Haettava ’M9 ja se tulee B sarakkeeseen
Range("B" & Vika 1).Offset(0, 3) = Haettava2 ’O6 ja se tulee E sarakkeeseen
Range("B" & Vika 1).Offset(0, 4) = Sheets("Syöttö").Range("D9") ja se tulee E sarakkeeseen
jne...
offset on 0 pohjainen joten
Range("B" & Vika 1).Offset(0, 0) on sama solu kuin Range("B" & Vika 1)
Range("B10").Offset(1, 3)=E11
jne...Elikä joudunko minä kirjoittamaan kaikki kopioitavat kohteet kolmeen kertaan tähän makroon?
Enkö voi kutsua kohteita makrossa?
Tämäkään ei vielä toimi elikä kun on sama erä samalle vuodelle sen kuuluu kysyä tallennetaanko päälle ja jos vastaa kyllä niin se tekee tallennuksen mutta mun kokeiluni tekee vain silloin kun se on viimeinen tallennus elikä ”vika”.
Miten korjaan?
Älkää hermostuko mulle mutta olen vielä taitamaton ja siksi jään ellei jakseta neuvoa.
Minä olen muuttanut alkuperäisen kyselyni jälkeen noita kohteita M9 ja O6.
Sub Kopioi()
Dim Vika As Integer
Dim Haettava2 As Range
Dim Haettava As Range
Dim Hakualue As Range
Dim Löydetty As Range
Dim EkaSolu As String
Sheets("Syöttö").Activate
Set Haettava2 = Range("M9")
Set Haettava = Range("O6")
Sheets("Data").Activate
Vika = Range("B65536").End(xlUp).Row
Set Hakualue = Range("B1:B" & Vika)
Range("B1").Select
Set Löydetty = Hakualue.Find(What:=Haettava, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False) ',SearchFormat:=False)
If Not Löydetty Is Nothing Then
EkaSolu = Löydetty.Address
If Löydetty.Offset(0, 3) = Haettava2 Then
MsgBox "Tiedot on jo olemassa", vbInformation
Exit Sub
Else
Do
Set Löydetty = Hakualue.FindNext(Löydetty)
If Löydetty.Offset(0, 1) = Haettava2 Then
Msg = "Erä on jo olemassa! " & "Haluatko tallentaa vanhan päälle!"
response = MsgBox(Msg, vbYesNo)
If response = vbYes Then Range("B" & Vika).Offset(0, 2) = Sheets("Syöttö").Range("D9")
Range("B" & Vika).Offset(0, 4) = Sheets("Syöttö").Range("A13")
Range("B" & Vika).Offset(0, 5) = Sheets("Syöttö").Range("L16")
Exit Sub
End If
Loop While Not Löydetty Is Nothing And Löydetty.Address EkaSolu
Range("B" & Vika 1) = Haettava
Range("B" & Vika 1).Offset(0, 1) = Haettava2
Range("B" & Vika 1).Offset(0, 2) = Sheets("Syöttö").Range("D9")
Range("B" & Vika 1).Offset(0, 4) = Sheets("Syöttö").Range("A13")
Range("B" & Vika 1).Offset(0, 5) = Sheets("Syöttö").Range("L16")
End If
Else
Range("B" & Vika 1) = Haettava
Range("B" & Vika 1).Offset(0, 1) = Haettava2
Range("B" & Vika 1).Offset(0, 2) = Sheets("Syöttö").Range("D9")
Range("B" & Vika 1).Offset(0, 4) = Sheets("Syöttö").Range("A13")
Range("B" & Vika 1).Offset(0, 5) = Sheets("Syöttö").Range("L16")
End If
End Sub
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Anteeksi mies
En vaan osaa kohdata sinua ja olla normaali. En tiedä mikä vaivaa. Samaan aikaan tekee mieli tulla lähelle ja kuitenkin5810367Mietin aina vain
Minä niin haluaisin nähdä sinut. Ei tuo yhden ainoan kuvan katsominen paljon helpota... Miksi sinä et voisi olla se roh174331Hetken jo luulin, että en ikävöi sinua koko aikaa
Mutta nyt on sitten taas ihan hirveä ikävä jotenkin. Tiedätköhän sinä edes, kuinka peruuttamattomasti minä olen sinuun r323616Kysely lieksan miehille
Olemme tässä pohtineet tällaista asiaa, että miten on. Tästä nyt on paljon ollut juttua julkisuudessakin aina sanomaleht1062996Outoa että Trump ekana sanoutui irti ilmastosopimuksesta
kun Kaliforniaa riepottelee siitä johtuvat tuhoisat maastopalot. Hirmumyrskytkin ovat USA:ssa olleet tuhoisia.4352162Palstan henkisesti sairaat ja lihavat
Täällä on sairaita, työttömiä ihmisiä kirjoittelemassa joilla ei ole tarkoituksena kuin satuttaa ihmisiä. Jos eksyt pals1142160Saan kengurakkaan kotiin viikon päästä
Mitä tapahtui? Martina hehkutti tätä stoorissaan reilu viikko sitten, mutta eipä aussimiestä Suomessa näkynyt, vaan tapa2501587FinFamin ryhmät
Älkää hyvät ihmiset luottako tähän tahoon. Ryhmiä on, mutta eivät ne toimi. Ihmisiä savustetaan ulos, vaikka näissä piir01381Osmo Peltola voitti ansaitusti Kultaisen Venlan - Kirvoitti yleisöltä mahtavan reaktion!
JEE, onnea Osmo! Osmo Peltola voitti Vuoden esiintyjän Kultainen Venla -palkinnon. Isä-Peltsin ja Osmon luontoseikkailu761213Olen vähän
Hysteerinen se on totta. Etkai ymmärrä miten syvästi tunnen sinua kohtaan. Ja olet aina lähelläni. Olet osa jo jotain. I101145