-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Delila_1
Topikgazda
Tényleg elkerülte a figyelmemet, elnézést.
A Munka1 laphoz rendelt makró:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then
Dim usor As Long
usor = Sheets("Munka2").Range("A50000").End(xlUp).Row + 1
Rows(Target.Row).Copy
beilleszt usor
End If
End SubÉs most a VB szerkesztőben a füzetedhez nyiss új modult. Insert, Module.
A kapott üres lapra ez jön:Sub beilleszt(usor)
Sheets("Munka2").Select
Rows(usor).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Munka1").Select
End SubÍgy már értéket illeszt majd be a Munka2-re.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Fire/SOUL/CD #9704 üzenetére
Isten éltessen!
Az ünneplés ellenére kiválóan működik a fantáziád.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Nagy baj, ha 1 gombnyomásra csinálja meg a két másolást? Ha nem, akkor az alábbi makró elintézi.
Sub copyz()
Sheets("Munka3").Select
Range("A8:A73").EntireRow.Insert
Sheets("Munka2").Range("A8:G38").Copy
Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Range("A8:G38").Copy Range("A43")
Cells(1).Select
End SubVIGYÁZAT! Nem lehetnek összevont cellák a 2-es lap A8:G38 tartományában, mert az értékmásolás nem tekinti azonos méretűnek a másolt-, és a beillesztési területet. Meg lehet másképp is oldani. Pl. a 31-32 sor C:E összegeit tedd a 32. sorba. Nem annyira látványos, mint most, de legalább működik.
A vízszintesen egyesített cellák helyett kiválóan lehet alkalmazni a következő formátumot: kijelölöd az A28:B28 cellákat, Cellaformázás, Igazítás fül, a Vízszintesen listából "A kijelölés közepére".Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
A csatolt képen a 3-as lapon ott van a cím, és egy 4 soros összegzés, aminek a másolás után lentebb kell kerülnie. A meglévő cím miatt első esetben sem kell a 2. lapról A1-gyel kezdeni a másolást, elég a 8. sortól.
Most megírtam úgy a makrót, hogy az első gombnyomásra beviszi a 2. lap adatait lentebb tolva az összegzést, másodikra ez alá beteszi a következőt, és még 2 esetben a következő kettőt. Vagyis ezzel összesen 4 árajánlatot másolhatsz be egymás alá.
Sub copyz()
Dim usor As Long
Sheets("Munka3").Select
usor = Range("E60000").End(xlUp).Row
Select Case usor
Case 13
Range("A8:A38").EntireRow.Insert
Sheets("Munka2").Range("A8:G38").Copy
Range("A8").Select
Case 44
Range("A40:G74").EntireRow.Insert
Sheets("Munka2").Range("A8:G38").Copy
Range("A43").Select
Case 79
Range("A74:G108").EntireRow.Insert
Sheets("Munka2").Range("A8:G38").Copy
Range("A78").Select
Case 114
Range("A109:G143").EntireRow.Insert
Sheets("Munka2").Range("A8:G38").Copy
Range("A113").Select
End Select
Sheets("Munka2").Range("A8:G38").Copy
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Cells(1).Select
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Delila_1 #9721 üzenetére
Eléggé elkapkodtam, sokkal rövidebben is meg lehet írni. Ennél is lehetne, de ahhoz számolnom kellene, amihez most nem fűlik a fogam.
Sub copyz()
Dim usor As Long, tol As Long, ig As Long, hova As String
Sheets("Munka3").Select
usor = Range("E60000").End(xlUp).Row
Select Case usor
Case 13
tol = 8: ig = 38: hova = "A8"
Case 44
tol = 40: ig = 74: hova = "A43"
Case 79
tol = 74: ig = 108: hova = "A78"
Case 114
tol = 109: ig = 143: hova = "A113"
End Select
Range("A" & tol & ":A" & ig).EntireRow.Insert
Sheets("Munka2").Range("A8:G38").Copy
Range(hova).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Cells(1).Select
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz bugizozi #9723 üzenetére
Minek ehhez makró, megoldották már az Excel fejlesztői.
Mentés másként opcióval mented, az Eszközök - Beállításoknál jelszót adsz a módosításhoz. Ezután a jelszó ismerete nélkül csak olvasásra lehet megnyitni.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Sub Bevisz()
Dim usor As Integer
Sheets("Kezdő_lap").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Másik_lap").Select
usor = Range("A1").End(xlDown).Row + 1
Range("A" & usor).Select
Selection.PasteSpecial Paste:=xlPasteFormats
Selection.PasteSpecial Paste:=xlPasteValues
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Sub Hozzair()
Dim usor As Integer
Workbooks.Open Filename:="F:\TMP\Ebből.xls"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Ebbe.xls").Activate
usor = Range("A65536").End(xlUp).Row + 1
Range("A" & usor).Select
Selection.PasteSpecial Paste:=xlPasteFormats
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("ebből.xls").Close
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Dr.Speed #9736 üzenetére
Erre való a Solver bővítmény. Ha nem találod az Eszközök között, a Bővítménykezelőben be kell jelölnöd.
2007-es verzióban máshol van, írd meg, ha azt a verziót használod.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz zz13zolika #9735 üzenetére
Ha ez az összevont cella mindig azonos méretű, a kép beszúrása után indítasz egy makrórögzítést, megformázod a képet, és a rögzítés befejeztével kiteszel hozzá egy gombot a lapodra.
A többi képet beszúrod, és kattintasz a gombra.[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Dr.Speed #9740 üzenetére
Makróval biztosan meg lehet oldani, de ahhoz ismerni kell a lap felépítését, melyik adat, képlet hol található.
Három egymásba ágyazott ciklus kell hozzá, ahogy látom.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Minek nevet adni? A kijelölés után azonnal beírhatja a nullát (még szerkesztőlécen való írás sem kell), és a Ctrl+enter azonnal minden kijelölt cellába beviszi az értéket.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
-
Delila_1
Topikgazda
válasz antikomcsi #9753 üzenetére
A Munka2 lap A oszlopát szöveg formátumként add meg, ha nem akarod, hogy a 6/1 dátumként jelenjen meg. Az adatok bevitele után jelöld ki, és adj nevet az A oszlopnak, legyen pl. termékek a név.
A Munka1 lapon az A oszlopban kijelölsz annyi cellát, amennyire gondolod, hogy majd feltöltöd, később bővítheted az érvényesítéssel ellátott tartományt. Adatok/ Érvényesítés. A Megengedve legördülőből Lista, a Forráshoz =termékek, OK.
A Munka1!B1-be: =HA(A1>"";FKERES(A1;Munka2!A:B;2;HAMIS);""), ezt másold le a többi cellára a B oszlopban.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz antikomcsi #9755 üzenetére
=A1 & " " & B1
Látod, tettem közé egy szóközt idézőjelek között.
Szerk.:
A képletedben a nullát nem kell zárójelbe tenni. Így is jó, csak felesleges.[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Makrón kívül mindenképp hibát okoz a körkörös hivatkozás.
Mi lenne, ha feltételes formázást adnál a cellákra? Nem ismerem a feladatot, csak arra gondoltam, hogy esetleg a formátumukkal jeleznék a megváltozott tartalmukat.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Valószínű, hogy egy képlet eredménye az A1 értéke.
Az A1, B1, C1, stb. cellákba írd meg a képletet. Az A1 ilyesmi legyen:=Ha(a_kapcsoló_1-et_mutat;ide_jön_a_képlet_azon_része_ami_a_számítást_elvégzi;"")
B1-ben a kritérium a kapcsoló 2-es állása.A következő fázisra váltás előtt az A1-et saját magára másolod értékként (irányított beillesztéssel), vagy ha módodban áll, elrejted a sort – hogy ne kelljen újra összeállítani egy esetleg 30 cm-es képletet.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz antikomcsi #9761 üzenetére
Szívesen.
A verzióra vonatkozó kérdésedet ne nekem tedd fel, mert én a 2007-est sem szeretem, csak az előző változatokat. Erre majd Fire (ha előkerül) azt mondja, hogy a 2015-ös (!) változatban tanulj ).
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz antikomcsi #9766 üzenetére
Másold le a B1 képletét: a cellán állva a jobb alsó sarkában van egy kis fekete négyzet, amit megfogsz az egérrel, és lehúzod addig, amíg szükséges.
Ha az A oszlopban már vannak adataid, akkor lehúzni sem kell, hanem a kis fekete négyzeten egy duplaklikk lemásolja addig, ameddig adatot talál a mellette lévő oszlopban.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Lehet, hogy igaza van Fire-nek az elírással kapcsolatban, de én úgy értettem a kérdést, hogy az érdekel, hány oszlopban van beállítva valamilyen feltétel szerinti szűrés.
Arra itt a makró hozzá:
Sub SzűrtOszlopok()
Dim oszlop As Integer, sz As Integer
Dim w As Worksheet
Dim FiltOszlop As String
Set w = Worksheets("Munka1")
With w.AutoFilter
FiltOszlop = .Range.Address
For oszlop = 1 To .Filters.Count
If w.AutoFilter.Filters.Item(oszlop).On Then sz = sz + 1
Next
End With
MsgBox sz
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Fire/SOUL/CD #9779 üzenetére
Az =részösszeg(9;A:A) megoldja a bővülő tartomány problémáját, csak a részösszeg függvény ne az A oszlopban legyen.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Igen, ez a SZUM függvénynek egy speciális változata. Az első paraméter azt határozza meg, hogy a tartomány adataival mit akarsz kezdeni. A 9 az összegüket, a 2 a darabszámukat számolja össze.
Nézd meg a súgót, ott vannak leírva a lehetséges paraméterek, és az alkalmazásuk.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Írj be valahova egy 1-est egy üres cellába. Másold (Ctrl+c), jelöld ki a cellákat, amik a bevételeket és kiadásokat tartalmazzák, jobb klikk, Irányított beillesztés, Szorzás.
Ez a művelet számokká alakítja a szövegesen előforduló értékeket, a nem szövegeseknek meg nem árt.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Rögzíts egy makrót a solver beállításaival, amibe minden feltételt vegyél be.
Legyen annyi üres lapod, ahány változatot szeretnél látni. Az első lapon van a kiinduló táblázat, nálam ez az A1:D5 terület, a célcella D6.Sub solver()
Dim lap As Long, max As Single, változat As Integer
max = 0
változat = 30 'Itt add meg a kért változatok számát
For lap = 1 To változat
Sheets(lap).Select
'Kiinduló változat másolása a következő lapra
If lap < 20 Then
Range("A1:D6").Select 'A saját területedet add meg itt
Selection.Copy Sheets(lap + 1).Cells(1)
End If
'Ide jön a rögzített makró
If Range("D6") > max Then max = Range("D6")
Next
MsgBox max
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz bozsozso #9806 üzenetére
Nálam nem a kívánt eredmény jött ki Bugizozi makrójával. Egy kicsit módosítottam rajta, és megjegyzéseket tettem bele.
Sub Összegzés()
Dim usorA As Long, usorG As Long, usor2A As Long
Sheets("Munka1").Select
usorA = Range("A1").End(xlDown).Row 'Alsó sor a Munka1 lapon
'Irányított szűrés egyedi ('A' oszlop) értékekre a G1-be
Range("A1:A" & usorA).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("G1"), Unique:=True
'Alsó sor a G oszlopban
usorG = Range("G1").End(xlDown).Row
'Első üres sor a Munka2 lap A oszlopában
usor2A = Sheets("Munka2").Range("A5000").End(xlUp).Row + 1
'Munka1 G oszlopának másolása a Munka2 A oszlopába
Range("G2:G" & usorG).Copy Sheets("Munka2").Range("A" & usor2A)
Sheets("Munka2").Select
'Szumha képlet a Munka2!B-be
Range("B2:B" & Range("A5000").End(xlUp).Row) = _
"=SUMIF(Munka1!A:A,Munka2!A2,Munka1!B:B)"
Cells(2, 1).Select
'Munka1!G törlése
Sheets("Munka1").Columns(7).Delete
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz bugizozi #9813 üzenetére
Valóban, a Te füzeted jó eredményt ad.
Érthetetlen számomra, mert a kódodat bemásoltam egy üres füzetbe, és úgy futtatva kaptam azt az eredményt, aminek a képét az előzőben közöltem. Másik füzetben is kipróbáltam, az eredmény ugyanaz a rossz összegzés.
Előfordul, hogy 1-1 lap hibás az Excelben (pont most volt egy ilyen esetem, hogy hibás volt egy szorzás eredménye), de hogy 2× egymás után 2 különböző füzetben?!
A képlet beírását azért nézd meg a makrómban, nem kell hozzá ciklus, egy lépésben meg lehet oldani, mint ahogy a G oszlop másolását is.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz bugizozi #9820 üzenetére
Másképp gondoltam...
A
Range("B2:B" & Range("A5000").End(xlUp).Row) = _
"=SUMIF(Munka1!A:A,Munka2!A2,Munka1!B:B)"sor után
Selection.Copy
Selection.PasteSpecial Paste:=xlValuesa makróból megoldaná.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Sub SortWorksheets()
Dim sCount As Integer, i As Integer, j As Integer
Application.ScreenUpdating = False
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i To sCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
Application.ScreenUpdating = True
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz bozsozso #9825 üzenetére
Igazad van, elfelejtettem, hogy a képletek beírásához nem jelöltem ki a B oszlop tartományát. Bemásolom a teljes makrót.
Sub Összegzés()
Dim usorA As Long, usorG As Long, usor2A As Long
Sheets("Munka1").Select
usorA = Range("A1").End(xlDown).Row 'Alsó sor a Munka1 lapon
'Irányított szűrés egyedi ('A' oszlop) értékekre a G1-be
Range("A1:A" & usorA).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("G1"), Unique:=True
'Alsó sor a G oszlopban
usorG = Range("G1").End(xlDown).Row
'Első üres sor a Munka2 lap A oszlopában
usor2A = Sheets("Munka2").Range("A5000").End(xlUp).Row + 1
'Munka1 G oszlopának másolása a Munka2 A oszlopába
Range("G2:G" & usorG).Copy Sheets("Munka2").Range("A" & usor2A)
Sheets("Munka2").Select
'Szumha képlet a Munka2!B-be
Range("B2:B" & Range("A5000").End(xlUp).Row).Select
Selection = "=SUMIF(Munka1!A:A,Munka2!A2,Munka1!B:B)"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Cells(2, 1).Select
'Munka1!G törlése
Sheets("Munka1").Columns(7).Delete
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz bozsozso #9838 üzenetére
Sheets.Add.Name = Sheets("Munka1").Range("B1")
Az I és K oszlophoz tegyél már be egy képet, hogy lássuk, mit szeretnél csinálni.
Ma én már leteszem a lantot, de biztosan lesz, aki segít.[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Mr.Csizmás #9852 üzenetére
Másold át a mostani füzetbe a régi lapot, ami az élőfejet tartalmazza, majd erre a lapra az előző tartalom helyett másold be a mostanit.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Mr.Csizmás #9854 üzenetére
Van most a füzetedben 1 lap, amiben jó az élőfej.
Indítasz egy makrórögzítést.
A jó lapon állva átkapcsolsz a nyomtatási képbe, ott is a beállításokba, az élőfejbe.
OK. Belépsz (ha van) az élőlábba, OK. Rögzítés vége.Szép hosszú makrót kapsz, amiből csak néhány sort hagysz meg:
With ActiveSheet.PageSetup
.LeftHeader = "Valami1"
.CenterHeader = "Valami2"
.RightHeader = "Valami3"
.LeftFooter = "Valami4"
.CenterFooter = "Valami5"
.RightFooter = "Valami6"
End WithTermészetesen a Valamik helyett a saját adataid lesznek az egyenlőségjel után.
Ha élőláb nincs, a Footer-es sorokat is kihagyhatod.
Most beviszel egy új makrót:Sub Élőfejek()
For lap = 1 To Worksheets.Count
Sheets(lap).Select
'***ide másolod be az előbb rögzített sorokat ***
With ActiveSheet.PageSetup
.LeftHeader = "Valami1"
.CenterHeader = "Valami2"
.RightHeader = "Valami3"
.LeftFooter = "Valami4"
.CenterFooter = "Valami5"
.RightFooter = "Valami6"
End With
'*******************************************************
Next
End SubAhol jelöltem, beviszed a rögzített makró rövidített részét, és futtatod az újat. Minden lapra bemásolja az élőfejet, és ha van, az élőlábat is.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Mr.Csizmás #9856 üzenetére
Szívesen.
Mi volt a 3 debug?Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Mr.Csizmás #9858 üzenetére
Na, ennek örülök. Nem a hibáknak, hanem az eredménynek.
Kicsit sok lett volna 50 lapra mindent átmásolni.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Mr.Csizmás #9860 üzenetére
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Mr.Csizmás #9862 üzenetére
Próbáltam együttesen kijelölt lapokra bevinni egy képet, de nem tudja.
Marad a Ctrl+c, Ctrl+v az elsőről a másodikra, a többi lapon már elég az F4 billentyű a művelet ismétlésére.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Új hozzászólás Aktív témák
Állásajánlatok
Cég: Alpha Laptopszerviz Kft.
Város: Pécs
Cég: Ozeki Kft.
Város: Debrecen