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
224
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
Useita puukotettu Tampereella
Mikäs homma tämä nyt taas on? "Useaa henkilöä on puukotettu Tampereen keskustassa kauppakeskus Ratinan lähistöllä." ht2364600Kuka rääkkää eläimiä Puolangalla?
Poliisi ampui toistakymmentä nälkiintynyttä eläintä Puolangalla Tilalta oli ollut karkuteillä lähes viisikymmentä nälkii763035- 472463
Meneeköhän sulla
oikeasti pinnan alla yhtä huonosti kuin mulla? Tai yhtä huonosti mutta jollain eri tyylillä? Ei olisi pitänyt jättää sua451767- 251613
- 781439
Lähetä terveisesi kaipaamallesi henkilölle
Vauva-palstalta tuttua kaipaamista uudessa ympäristössä. Kaipuu jatkukoon 💘851285PS uusimman gallupin rakettimainen nousija
https://yle.fi/a/74-20170641 Aivan ylivoimaisesti suurin kannatuksen nousu PS:lle. Nousu on alkanut ja jatkuu 2 vuoden143965- 69938
Sellainen tunne sydämessä
Että nainen olet kaivannut minua. Tai sanonko että oikeastaan koet sitä samaa nostalgiaa, kaipuuta ja mukavia muistoja,86894