1. Suomenkielinen excel. Työkirjat malli_01 ja toinen työkirja malli_02 sarakkeita a:sta p:en ja rivejä 1000.
Pitäisi tuoda malli_01 :een malli_02:sta sarakke ja rivitiedot ja seljälkeen järjestää rivit sarakkeen A mukaan aakkosjärjestykseen.
2. Sama työkirja ja kaksi taulukkoa. Pitäisi tuoda malli_01 :een malli_01b:sta sarakke ja rivitiedot malli_01:een ja seljälkeen järjestää rivit sarakkeen A mukaan aakkosjärjestykseen.
3. Työkirjat malli_01 ja toinen työkirja malli_04 sarakkeita a:sta p:n ja rivejä 1000. Pitäisi poistaa koko rivitieto malli_01:sta jos sarakkeista A,C ja D jos löytyy sama tieto kuin malli_04 sarakkeista A,C ja D
3 erillistä makroa
Tietojen tuominen toisesta työkirjasta makrolla
2
106
Vastaukset
Muuttele nimet ja polut oikeaksi
Sub Makro1()
Dim polku As String
Dim tiedostonnimi As String
Dim lähde As Workbook
polku = "C:\"
tiedosto = "malli_02"
Worksheets("Taul1").Range("A:P") = ""
Set lähde = Workbooks.Open(polku & tiedosto)
ThisWorkbook.Worksheets("Taul1").Range("A1:P1000").Value = lähde.Sheets("Taul1").Range("A1:P1000").Value
lähde.Close False
Range("A1").Select
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Add Key:=Range("A1:A20"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Taul1").Sort
.SetRange Range("A1:P1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub Makro2()
Worksheets("Taul1").Range("A:P") = ""
Worksheets("Taul1").Range("A1:P1000").Value = Worksheets("Taul2").Range("A1:P1000").Value
Range("A1").Select
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Add Key:=Range("A1:A20"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Taul1").Sort
.SetRange Range("A1:P1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub Makro3()
Dim vika As Long
Dim löydetty As Range
Dim löydetty2 As Range
Dim polku As String
Dim tiedostonnimi As String
Dim lähde As Workbook
Dim solu As Range
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Huuhaa").Delete
On Error GoTo virhe
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Huuhaa"
polku = "C:\"
tiedosto = "malli_04"
Set lähde = Workbooks.Open(polku & tiedosto)
ThisWorkbook.Worksheets("Huuhaa").Range("F1:I1000").Value = lähde.Sheets("Taul1").Range("A1:D1000").Value
lähde.Close False
ThisWorkbook.Worksheets("Taul1").Range("A1:D1000").Copy Worksheets("Huuhaa").Range("A1:D1000")
With Worksheets("Huuhaa").Range("E1")
.FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-1]"
.AutoFill Destination:=Range("E1:E20")
End With
With Worksheets("Huuhaa").Range("J1")
.FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-1]"
.AutoFill Destination:=Range("J1:J20")
End With
vika = Worksheets("Huuhaa").Range("J65536").End(xlUp).Row
For Each solu In Worksheets("Huuhaa").Range("J1:J" & vika)
Set löydetty = EtsiJaSiirrä(solu, Columns("E:E"))
If Not löydetty Is Nothing Then
If löydetty2 Is Nothing Then
Set löydetty2 = löydetty
Else
Set löydetty2 = Union(löydetty2, löydetty)
End If
End If
Next
Worksheets("Taul1").Range(löydetty2.Address).EntireRow.Delete
virhe:
ThisWorkbook.Worksheets("Huuhaa").Delete
Application.DisplayAlerts = True
End Sub
Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Huuhaa").Activate
With HakuAlue
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
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Kuvat! Dannyyn liitetty Helmi Loukasmäki, 22, on puhjennut naisena kukkaan - Some sekoaa: "Sä..."
Ooo, kaunis aikuinen nainen Helmistä on kasvanut siinä yli 80-vuotiaan Dannyn rinnalla! Katso uudet kuvat: https://ww685653- 613774
Suodatinpussin kastelemalla saa parempaa kahvia
Kokeilin niksiä ja kyllä tämä kahvi on parempaa nyt. Ei lainkaan maistu paperiselta. Huljuttelee hanan alla suppiloa pap1532765Tidätkö nainen
että suoraan sanottuna v.tut.aa että pääsit näin lähelle minua. Ei olisi oikeasti aikaa tähän mutta silti aina välillä o1052206Mikä on kaivattusi etunimi?
Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.1102069Oho! Arja Koriseva paljastaa TTK:n ekasta suorasta lähetyksestä: "On vähän ärsyttävä yhtälö!"
Upea Arja Koriseva! Tsemppiä haasteelliseen tilanteeseen! Lue lisää: https://www.suomi24.fi/viihde/oho-arja-koriseva-211339Onkohan sinulla kaikki hyvin?
Nyt vähän sellainen outo tunne tuli. Sinun asiasi niin ei minulle toki tarvitse kertoa. Kunhan mietin...381297En kestä katsoa
Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois961278Huikeeta, mahtavaa, ihan mielettömän upeeta
Me ostettiin talo Espanjasta. Tosin saadaan käyttää sitä vain muutama viikko vuodessa kun on monta muutakin ostajaa! M1951232- 1731146