Idézet: PoHoS - Dátum: 2012. 05. 31. 23:14
Szép estét!
Remélem jól értelmeztem a felvázolt helyzetet és hasonló funkcióra van szükséged mint amit a linkelt állomány tartalmaz.
https://dl.dropbox.c...hkpk_excel.xlsx
"A" munkalapon mindenképpen szükséges a segédoszlop és, hogy az első oszlopban legyen. Fel lehet tölteni vele pár száz/ezer sort és utána el is lehet rejteni.
Kivonat munkalapon lévő előre kialakított területre mehet is a kiíratás azzal a szép függvénnyel.
Vagy ha ez nem kivitelezhető akkor az INDEX és HOL.VAN kombinálásával talán lehet mit kezdeni.
Üdv
PoHoS
VAU!
Megpróbálom applikálni, kösz! Egyébként most egy ilyen makró biztosítja a dolgot:
Private Sub Workbook_Open()
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Türelem, a VO oldal aktualizálása folyamatban..."
Application.ScreenUpdating = False
For Each lap In ActiveWorkbook.Sheets
If lap.Name = "VO" Then
lap.Select
ActiveSheet.Unprotect
rekordszám = ActiveCell.SpecialCells(xlLastCell).Row()
'Minden adatot töröl a VO lapról az A-G oszlopokból (Valamiért ekkor törlődnek a H oszlopból is képletek, ami nem baj :-o)
'(Fejsor marad)
Range(Cells(2, 1), Cells(rekordszám, 7)).Select
Selection.Delete
Cells(2, 1).Select
'A TELJES munkalapról kell az A-G oszlop, ill. az N oszlop adata,
'azok a sorok, melyek első cellájában (A oszlop) "O" szerepel
Sheets("TELJES").Select
ActiveSheet.Unprotect
rekordszám = ActiveCell.SpecialCells(xlLastCell).Row()
For Each ciklus_cella In Range(Cells(2, 1), Cells(rekordszám, 1))
If ciklus_cella.Value = "O" Then
Range(Cells(ciklus_cella.Row, 2), Cells(ciklus_cella.Row, 7)).Copy
Sheets("VO").Select
ActiveSheet.Paste
Cells(ActiveCell.Row, 7).Select
Sheets("TELJES").Select
Cells(ciklus_cella.Row, 14).Copy
Sheets("VO").Select
ActiveSheet.Paste
'MakróPara egy rejtett oldal, minek két oszlopa lényeges (A-B), A-ban u.a
'adat van, mint a VO lapon az E oszlopban. Kell az adathoz rendelt tulajdnonság,
'ami a rejtett oldal B oszlopában van.
'Azért van ez így megoldva, mert a TELJES lapon összevont cellák vannak, ettől
'FKERES csődöt mond.
Cells(ActiveCell.Row, 8).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],MakróPara!R2C1:R60C2,2,FALSE)"
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Locked = True
Selection.FormulaHidden = True
Cells(ActiveCell.Row + 1, 1).Select
Sheets("TELJES").Select
End If 'ciklus_cella.Value = "O"
Next ciklus_cella
End If 'lap.Name = "VO"
Next lap
Application.CutCopyMode = False
Sheets("VO").Select
ActiveSheet.Protect
Sheets("TELJES").Select
ActiveSheet.Protect
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
ActiveWorkbook.Save
End Sub
Szóval ez a makró lefut(na) minden megnyitáskor.
A problémák:
-ha nem engedélyezett a makrók futtatása, a lefutás elmarad.
-menet közben nem aktualizálódik a VO lap, ahhoz be kell zárni a munkafüzetet, és meg kell nyitni.
Súgó
A téma zárva.
