apuja vääntöön

Walt kirjoitti:

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

kirjoitti:

Anonyymi

Kirjoita kommentti

5000

Lähetä