-
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
veterán
válasz
m.zmrzlina
#10065
üzenetére
Le a kalappal!
Van egy baj: a lehetséges betűk száma 14, HA függvényből viszont csak hetet lehet egymásba ágyazni. Ez az az eset, mikor makrót kell írni.
Sub Leiras()
Dim sor%, oszlop%, betu%, nev$
Range("K57:K75,M57:M75,P57:P75").ClearContents
For sor% = 57 To 75
oszlop% = 10: GoSub Beir
oszlop% = 12: GoSub Beir
oszlop% = 15: GoSub Beir
Next
Exit Sub
Beir:
nev$ = Cells(sor%, oszlop%)
For betu% = 1 To Len(nev$)
Cells(sor%, oszlop% + 1) = Cells(sor%, oszlop% + 1) & Application.VLookup(Mid(nev, betu%, 1), Range("R57:S70"), 2, 0) & " "
Next
Cells(sor%, oszlop% + 1) = Left(Cells(sor%, oszlop% + 1), Len(Cells(sor%, oszlop% + 1)) - 1)
Return
End Sub -
Delila_1
veterán
válasz
MIFtIli
#10054
üzenetére
A helyére nem, de mellé az FKERES függvénnyel beírhatod a leírást.
Kicsit összetettebb a feladat, ha egy cellában pl. acd szerepel, és ahhoz 3 leírás tartozik.
Add meg pontosan, hol szerepelnek a betűk, és hol van a hozzájuk tartozó leírás.Valaki biztosan segít, én kikapcsolok, dörög, villámlik, és nincs villámvédelmem.

-
Delila_1
veterán
válasz
zsotesz81
#10058
üzenetére
Nem értem, miért ragaszkodsz a makróhoz, mikor egyszerű képlettel meg lehet oldani.
Tulajdonképpen az érdekel, hogy a Sheet1 lapon szerepel-e mindenkinek a neve, akinek a címe megvan a Sheet2-n.Az F1-be tedd be ezt a képletet:
=HA(HIBÁS(FKERES(Sheet2!B1&"*";E:E;1;0));"Nincs a Sheet1 lapon";"X") ,majd a cella jobb alsó sarkában lévő kis fekete négyzetre duplaklikk, és már le is másolta addig, ameddig az E oszlopban talál adatot.
-
Delila_1
veterán
válasz
zsotesz81
#10055
üzenetére
Eszerint megint átrendezted az adataidat.
Ha az Excelben szúrsz be egy oszlopot, vagy sort, avagy törölsz, akkor a képletek automatikusan átíródnak. A makrónál nem ez a helyzet. Ha ott azt írod, hogy az ötödik oszlop adatával csináljon valamit (van is a képletben ilyen hivatkozás: C5), akkor azt csinálja. Ha ott nem azt az adatot találja, ami a beszúrás-törlés előtt volt, akkor hibás eredményt kapsz.
A makrót arra az esetre írtam, mikor az elrendezésed a 10051 hsz. szerinti volt.Itt le is tettem a lantot. Még annyit segítek, hogy a 10048-as hsz-ban megadott képleteket alakítsd át a jelenlegi elrendezésre – majd 5 percenként az újabbakra –, indíts makrórögzítést, enterezd le a két képletet, és a rögzített sorokat másold be a Range("F1:F" & usor).FormulaR1C1 = _, és a Range("G1:G" & usor).FormulaR1C1 = _ sorokhoz.
-
Delila_1
veterán
válasz
zsotesz81
#10051
üzenetére
Tényleg prérifarkas vagy, az első kérdésedben más volt az elrendezés. A válaszom emiatt adott #NAME eredményt.
A pontatlanságoddal – hogy ne írjak hebehurgyaságot – megdolgoztatod azokat, akiknek a segítségét kéred.A ciklusok hosszú időd vesznek igénybe, pláne, ha 2 különálló táblázaton kell végig futniuk. Sokkal gyorsabb és egyszerűbb 1-1 lépésben megadni a képleteket, majd ezek helyére beilleszteni az értéküket.
A jelenlegi felállásra:
Sub X_ek()
Dim usor%
Sheets("Sheet1").Select
usor = Range("E6000").End(xlUp).Row
Range("F1:F" & usor).FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(Sheet2!RC2&""*"",C5,1,0)),""nincs"",IF(RIGHT(VLOOKUP(Sheet2!RC2& ""*"",C5,1,0),9)=""Contr/IBM"",""X"",""""))"
Range("G1:G" & usor).FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(Sheet2!RC2&""*"",C5,1,0)),""nincs"",IF(RIGHT(VLOOKUP(Sheet2!RC2& ""*"",C5,1,0),9)=""vakia/IBM"",""X"",""""))"
Columns("F:G").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Range("F1").Select
End Sub -
Delila_1
veterán
válasz
zsotesz81
#10045
üzenetére
Akkor kell bele egy hibaelhárítás is.
D1:
=HA(HIBÁS(FKERES($A1&"*";Sheet2!$E:$E;1;0));"";HA(JOBB(FKERES($A1& "*";Sheet2!$E:$E;1;0);9)="Contr/IBM";"X";""))E1:
=HA(HIBÁS(FKERES($A1&"*";Sheet2!$E:$E;1;0));"";HA(JOBB(FKERES($A1& "*";Sheet2!$E:$E;1;0);9)="vakia/IBM";"X";"")) -
Delila_1
veterán
válasz
zsotesz81
#10038
üzenetére
A Sheet1 lap D1 cellájába:
=HA(JOBB(FKERES($A1& "*";Sheet2!$E:$E;1;0);9)="Contr/IBM";"X";"")E1-be: =HA(JOBB(FKERES($A1& "*";Sheet2!$E:$E;1;0);9)="vakia/IBM";"X";"")
Az A oszlopban lévő nevek mellé a D oszlopba tesz X-et, ha a "Contr" szerepel a címében, és az E-be, ha nem.
Nem biztos, hogy jól értem a feladatot, látom, Fire másként értelmezte.
-
Delila_1
veterán
válasz
varikahun
#10028
üzenetére
A 10032-be írt sor elé még egyet tegyél be, amivel együtt így néz majd ki az egész:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 3 Then Exit Sub
If IsEmpty(Target) Then Range(Cells(Target.Row, 1), Cells(Target.Row, 15)).Interior.ColorIndex = xlNone
If Target.Column = 3 And Target = "OK" Then _
Range(Cells(Target.Row, 1), Cells(Target.Row, 15)).Interior.ColorIndex = 6
If Target.Column = 16 And Target = "Worn" Then _
Range(Cells(Target.Row, 1), Cells(Target.Row, 15)).Interior.ColorIndex = 3
End Sub -
Delila_1
veterán
válasz
varikahun
#10024
üzenetére
A lapfülön jobb klikk, Kód megjelenítése.
Bejutottál a VB szerkesztőbe, jobb oldalon kaptál egy üres felületet, ide másold be:Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target = "OK" Then _
Range(Cells(Target.Row, 1), Cells(Target.Row, 15)).Interior.ColorIndex = 6
If Target.Column = 16 And Target = "Worn" Then _
Range(Cells(Target.Row, 1), Cells(Target.Row, 15)).Interior.ColorIndex = 3
End SubEz a C oszlopban megadott OK-ra sárga hátteret ad, a P-be beírt Worn-re pirosat.
A színeket a makróban a 6, ill. a 3 módosításával tudod változtatni. -
Delila_1
veterán
válasz
varikahun
#10017
üzenetére
Jelöld ki a tartományt, amit színezni akarsz. Hívd be a Formátum - Feltételes formázást.
A feljövő ablakban a legördülőben legyen "A képlet értéke", a másodikba írd be: =$C$3="OK", a Formátumnál add meg a megfelelő formátumot.
Ez a 2003-as verzióra vonatkozik, szólj, ha nem ezt használod. -
Delila_1
veterán
válasz
Danecay
#9991
üzenetére
Az E1-től kezdődően bevittem a napokat: 15, 16, ... 31.
Bementem a névadásba, és a napok nevet adtam meg. A hivatkozáshoz ez a kis képlet jött:=OFSZET(Munka1!$E$1;0;0;HOL.VAN(NAP(EOMONTH(MA();0));Munka1!$E:$E;0);1)
Az érvényesítésnél a forráshoz ezt adtam meg: =napok
A gépen a dátumot februárra átírva az érvényesítés 15-től 28-ig, áprilisban 30-ig, májusban 31-ig teszi választhatóvá a napokat.
U.i.:
Ha nincs eomonth függvényed, az Eszközök/Bővítménykezelőben kapcsold be a két Analysis kezdetű bővítményt. -
Delila_1
veterán
válasz
Danecay
#9989
üzenetére
A legördülőnél alkalmazd az érvényesítést. Melyik verziót használod? Más helyen találod meg a 2007-ben és a régebbiekben.
A makróban meg kell adnod az útvonalat és a fájl nevét.
utvonal= "meghajtó:\mappa\almappa\"
FN="MentendőFileNeve"Megadhatod, hogy az aktuális hónap nevével mentsen.
ment=utvonal & FN & "_" & Format(Now, "yyyy.mm") & ".xls"
ActiveWorkbook.SaveAs ment
ActiveWindow.Close 'ezzel bezárod -
Delila_1
veterán
válasz
Fire/SOUL/CD
#9958
üzenetére
Törtekkel is hibátlan?
-
Delila_1
veterán
válasz
bozsozso
#9955
üzenetére
Ez egy szükség-megoldás, de attól még az Excel hibája nem szűnt meg.
A ciklus lelassítja a futást, nálam több nagy területről van szó.Próbálgattam, hogy makróból az irányított beillesztéssel történő felszorzást elvégzi, csak éppen a területet cellánként le kell enterezni (!)

Ez persze nem megoldás. Gondoltam, hogy a felszorzás után ugyanarra a területre nyomok egy Paste:=xlValues-t, de az sem javított rajta.A 2007-ből már kiirtották ezt a hibát – tettek helyette egyebet.
-
Delila_1
veterán
Fire
Ez a Te profilod. Meg kellene beszélni Microsoftékkal, hogy egy tartomány (ami szöveg formátumú számokat tartalmaz) makróból csak akkor szorozható fel – alakítható át a művelettel számokká –, ha a tartomány nem tartalmaz törteket. Egész számoknál nincs probléma.
-
Delila_1
veterán
válasz
bozsozso
#9940
üzenetére
Fogalmam sincs. Mostanában jártam én is így. Az eredeti, szöveg formátumú számok tizedes elválasztója pont volt, azokat makróval kicseréltettem vesszőre, ezután jött volna az irányított beillesztés. Ez már nem jött össze.
Addig írtam meg, hogy egy változóba bevettem az 1-et, kijelöltem a nem összefüggő területeket, és egy üzenetet küldtem, hogy illessze be irányítottan, szorzásként.

-
Delila_1
veterán
Ezt próbáld meg futtatni:
Sub hiper()
Dim usor As Long, sor As Long, A As String, B As String
Calculate
usor = Range("A6000").End(xlUp).Row
For sor = 1 To usor
Cells(sor, 1).Select
A = Cells(sor, 46)
B = Cells(sor, 1)
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
A, TextToDisplay:=B
Next
End Sub -
Delila_1
veterán
válasz
bozsozso
#9901
üzenetére
Ez az új a Munka2 lapon a B oszlopba írja a Munka1 H oszlopát, és a C-be az I-t.
Sub Összegzés()
Dim usorA As Long, usorT 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 T1-be
Range("A1:A" & usorA).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("T1"), Unique:=True
'Alsó sor a T oszlopban
usorT = Range("T1").End(xlDown).Row
'Első üres sor a Munka2 lap A oszlopában
usor2A = Sheets("Munka2").Range("A5000").End(xlUp).Row + 1
'Munka1 T oszlopának másolása a Munka2 A oszlopába
Range("T2:T" & usorT).Copy Sheets("Munka2").Range("A" & usor2A)
Sheets("Munka2").Select 'Szumha képlet a Munka2!B-be
usorA = Range("A1000").End(xlUp).Row
Range("B2:B" & usorA).Select
Selection = "=SUMIF(Munka1!A:A,Munka2!A2,Munka1!B:B)"
Range("C2:C" & usorA) = "=VLOOKUP(A2:A" & usorA & ",Munka1!A:I,8,0)"
Range("D2:D" & usorA) = "=VLOOKUP(A2:A" & usorA & ",Munka1!A:I,9,0)"
Range("A:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Cells(2, 1).Select
'Munka1!T oszlop törlése
Sheets("Munka1").Columns(20).Delete
End Sub -
Delila_1
veterán
válasz
Mr.Csizmás
#9896
üzenetére
Köszi. Ennyire bamba vagyok!
Hiába, április elseje van.¡ǝɾǝslǝ sılıɹdɐ uǝɾlǝ
-
Delila_1
veterán
válasz
Mr.Csizmás
#9894
üzenetére
Akkor írd le, mi módon jött össze!
Nehogy mind a 90-et, elég 1.
-
Delila_1
veterán
válasz
Mr.Csizmás
#9890
üzenetére
Tudtommal az élőfejbe nem lehet képfájlt bevinni, csak a Wordben.
-
Delila_1
veterán
Azt hittem, bevitted a sokkal egyszerűbb óra:perc formátumot.
Még mindig jobban járnál vele.Egy üres oszlopban összehozhatnád az A és B, valamint a C és D oszlopok értékeit.
=A1&":"&B1
=C1&":"&D1Ezeket már időértéknek értelmezi az Excel. Értékként beilleszted az új oszlopokat az A-ba és B-be, és már mehet is az egyszerű kivonási képlet ezekre hivatkozva.
-
Delila_1
veterán
válasz
Mr.Csizmás
#9866
üzenetére
A képet a beillesztés előtt szabd méretre!
Sub Logo()
utvonal = "F:\Temp\"
FN = "filename.gif"
For lap = 1 To Worksheets.Count
Sheets(lap).Select
Cells(3, 1).Select 'Ez az A3-ba teszi, átírhatod
ActiveSheet.Pictures.Insert (utvonal & FN)
Next
End Sub -
Delila_1
veterán
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. -
Delila_1
veterán
válasz
Mr.Csizmás
#9860
üzenetére

-
Delila_1
veterán
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. -
Delila_1
veterán
válasz
Mr.Csizmás
#9856
üzenetére
Szívesen.
Mi volt a 3 debug? -
Delila_1
veterán
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.
-
Delila_1
veterán
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.

-
Delila_1
veterán
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 Sub -
Delila_1
veterán
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 Sub -
Delila_1
veterán
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.
-
Delila_1
veterán
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 Sub -
Delila_1
veterán
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 Sub -
Delila_1
veterán
Í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.

-
Delila_1
veterán
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. -
Delila_1
veterán
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.
-
Delila_1
veterán
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 -
Delila_1
veterán
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.
-
Delila_1
veterán
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
). -
Delila_1
veterán
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.
-
Delila_1
veterán
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. -
Delila_1
veterán
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.
-
Delila_1
veterán
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. -
Delila_1
veterán
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 Sub -
Delila_1
veterán
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 Sub -
Delila_1
veterán
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 Sub -
Delila_1
veterán
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 Sub -
Delila_1
veterán
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".
Új hozzászólás Aktív témák
- Kormányok / autós szimulátorok topikja
- Facebook és Messenger
- Meghozta a régóta várt asztali Ryzen APU-kat az AMD
- Spórolós topik
- Bittorrent topik
- E-roller topik
- Anime filmek és sorozatok
- Valószínűleg késnek majd a Valve új Steam eszközei
- Picit késett, de befutott a Vivo V70 FE is
- Kamionok, fuvarozás, logisztika topik
- További aktív témák...
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Fallout 4 Pip-Boy Edition eladó
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- BESZÁMÍTÁS! 4TB Seagate Skyhawk ST4000 SATA HDD meghajtó garanciával hibátlan működéssel
- Ventilátor bazár /NZXT/CORSAIR/LIAN LI/DEEPCOOL/ZALMAN/120MM/140MM/VEZÉRLŐK/LED KIT-ek/
- ÁRGARANCIA!Épített KomPhone Ryzen 7 7800X3D 32/64GB RAM RX 9070 XT 16GB GAMER PC termékbeszámítással
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
- BESZÁMÍTÁS! Apple MacBook Pro 14 M4 Max 36GB RAM 1TB SSD macbook garanciával hibátlan működéssel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest



![;]](http://cdn.rios.hu/dl/s/v1.gif)






Erre majd Fire (ha előkerül) azt mondja, hogy a 2015-ös (!) változatban tanulj
Fferi50