Moi, olisko jollai ideaa, kuinka tällasta koodia sais siistittyy ja että sen sais toimiin isommallakin tiedostolla. Saiskoha siitä semmosta silmukkaa aikaseks.
Sub Button2_Click()
Dim areaT1, areaT2, cellT1, cellT2
Sheets("Sheet2").Activate
areaT2 = "B1:B" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT1 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT1 In Sheets("Sheet1").Range(areaT1)
For Each cellT2 In Sheets("Sheet2").Range(areaT2)
If cellT1.Value = cellT2.Value Then
Cells(cellT1.Row, 3).Value = Sheets("Sheet2").Cells(cellT2.Row, 1).Value
Cells(cellT1.Row, 4).Value = Sheets("Sheet2").Cells(cellT2.Row, 3).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT3, areaT4, cellT3, cellT4
Sheets("Sheet2").Activate
areaT4 = "D1:D" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT3 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT3 In Sheets("Sheet1").Range(areaT3)
For Each cellT4 In Sheets("Sheet2").Range(areaT4)
If cellT3.Value = cellT4.Value Then
Cells(cellT3.Row, 5).Value = Sheets("Sheet2").Cells(cellT4.Row, 1).Value
Cells(cellT3.Row, 6).Value = Sheets("Sheet2").Cells(cellT4.Row, 5).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT5, areaT6, cellT5, cellT6
Sheets("Sheet2").Activate
areaT6 = "G1:G" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT5 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT5 In Sheets("Sheet1").Range(areaT5)
For Each cellT6 In Sheets("Sheet2").Range(areaT6)
If cellT5.Value = cellT6.Value Then
Cells(cellT5.Row, 7).Value = Sheets("Sheet2").Cells(cellT6.Row, 1).Value
Cells(cellT5.Row, 8).Value = Sheets("Sheet2").Cells(cellT6.Row, 8).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT7, areaT8, cellT7, cellT8
Sheets("Sheet2").Activate
areaT8 = "I1:I" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT7 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT7 In Sheets("Sheet1").Range(areaT7)
For Each cellT8 In Sheets("Sheet2").Range(areaT8)
If cellT7.Value = cellT8.Value Then
Cells(cellT7.Row, 9).Value = Sheets("Sheet2").Cells(cellT8.Row, 1).Value
Cells(cellT7.Row, 10).Value = Sheets("Sheet2").Cells(cellT8.Row, 10).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT9, areaT10, cellT9, cellT10
Sheets("Sheet2").Activate
areaT10 = "L1:L" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT9 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT9 In Sheets("Sheet1").Range(areaT9)
For Each cellT10 In Sheets("Sheet2").Range(areaT10)
If cellT9.Value = cellT10.Value Then
Cells(cellT9.Row, 11).Value = Sheets("Sheet2").Cells(cellT10.Row, 1).Value
Cells(cellT9.Row, 12).Value = Sheets("Sheet2").Cells(cellT10.Row, 13).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT11, areaT12, cellT11, cellT12
Sheets("Sheet2").Activate
areaT12 = "N1:N" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT11 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT11 In Sheets("Sheet1").Range(areaT11)
For Each cellT12 In Sheets("Sheet2").Range(areaT12)
If cellT11.Value = cellT12.Value Then
Cells(cellT11.Row, 13).Value = Sheets("Sheet2").Cells(cellT12.Row, 1).Value
Cells(cellT11.Row, 14).Value = Sheets("Sheet2").Cells(cellT12.Row, 15).Value
End If
Next
Next
Application.ScreenUpdating = True
End Sub
apuja vääntöön
Walt
0
277
Vastaukset
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Miksi jollain jää "talvi päälle"
Huvittaa kastoa ullkona jotain vahempaa äijää joka pukeutuu edelleen kun olisi +5 astetta lämmittä vaikka on helle keli2732750Mitä et hyväksy miehessä/naisessa josta olet kiinnostunut?
Itse en halua, että miehellä olisi lapsia!2101761Se katse silloin
Oli hetki, jolloin katseemme kohtasivat. Oli talvi vielä. Kerta toisensa jälkeen palaan tuohon jaettuun katseeseen. Tunt581475Tiesitkö? Farmi Suomi Kirsikka Simberg on tämän julkkisnaisen tytär - Katso tyrmäävät mallikuvat!
Oho, aikamoinen ylläri. Tiesitkö?! Kirsikka Simberg on yksi tämän kauden Farmi Suomi -kisaajista. Hänellä ei ole tuttu t11231- 791176
Tuhdit oluet kauppoihin. Miksi vastustaa?
8% oluet kauppoihin mutta mikä siinä on että osa politikoista vstustaa ? Kauppa kuitenkin hinnoittelee vahvan oluen ni2371086- 801022
Sinua tulen kyllä ikävöimään pitkään nainen
mutta oli pakko tehdä päätös oman mielenrauhan vuoksi. Toivottavasti saat elämältä kaiken mitä haluat.52953- 73837
Kärsämäki rosvojen ja tuhopolttajien kylä?
Poliisi ampui uhkaava miestä Kärsämäellä. Ja vasta joku poltti rivitalon. Mikä riivaa Kärsämäkisiä? Joko tuulimyllyjen15740