-
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
andreas49
#49098
üzenetére
Sub AblakRogzites()Dim lap As IntegerApplication.ScreenUpdating = FalseFor lap = 1 To Worksheets.CountSheets(lap).SelectRange("B2").Select 'Itt írd át a rögzítés helyétActiveWindow.FreezePanes = TrueNextApplication.ScreenUpdating = TrueEnd SubEz a makró minden lapon rögzíti az ablaktáblát B2-ben. Az első sor és első oszlop nem mozdul el görgetéskor. A B2 helyét átírhatod az igényednek megfelelően.
-
lappy
őstag
válasz
andreas49
#49081
üzenetére
nincs olyan függvény csak makróval lehet
Sub HomeAllSheets()
Dim sh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each sh In ActiveWorkbook.Worksheets
sh.Select
Range("A1").Select
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Next sh
Sheets(1).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub -
Mutt
senior tag
válasz
andreas49
#49005
üzenetére
Szia,
Itt egy makrós változat, amely a KIJELÖLT oszlopon végzi el az átalakítást és mellé írja be a kapott értékeket. Mivel nem írtad hogy mi történjen ha a formátum nem követi az "abc (def) [ghi]" formátumot ezért ahogy nekem logikusnak tűnt írtam meg a kódot. A kommentek alapján próbáld meg módosítani.
Sub Szetszed()
Dim cella As Range
Dim adatsor As Range
Dim pos1 As Long, pos2 As Long, pos3 As Long
Dim text1 As String, text2 As String, text3 As String
'a kijelölt és adatokat tartalmazó tartományt használjuk csak
Set adatsor = Application.Intersect(Selection, ActiveSheet.UsedRange)
'végig megyünk a cellákon
For Each cella In adatsor
text1 = ""
text2 = ""
text3 = ""
'keressük a szövegben a zárójelet
pos1 = InStr(1, cella, "(")
'ha van zárójel akkor a csonkoljuk a szöveget a talált pozícióig
If pos1 > 0 Then
'ha van zárójel akkor a csonkoljuk a szöveget a talált pozícióig
text1 = Trim(Left(cella, pos1 - 1))
'keressük a szögletes árójelet
pos2 = InStr(pos1, cella, "[")
If pos2 > 0 Then
'ha van szögletes, akkor kivesszük a szöveget a zárójel utáni pozíciótól kezdve
text2 = Replace(Trim(Mid(cella, pos1 + 1, pos2 - pos1 - 1)), ")", "")
text3 = Replace(Trim(Mid(cella, pos2 + 1, Len(cella) - pos2)), "]", "")
Else
'nincs szögletes zárójel, de sima volt
pos2 = InStr(pos1, cella, ")")
text2 = Trim(Mid(cella, pos1 + 1, pos2 - pos1 - 1))
text3 = Trim(Mid(cella, pos2 + 1, Len(cella) - pos2))
End If
Else
'nem volt zárójel tartsuk meg az eredeti szöveget
text1 = cella
End If
'eredeti cella melletti oszlopokba írjuk az eredményt
cella.Offset(, 1) = text1
cella.Offset(, 2) = text2
cella.Offset(, 3) = text3
Next cella
End Subüdv
-
Mutt
senior tag
válasz
andreas49
#49000
üzenetére
Szia,
Van hibaüzenet?
Ez egy UDF (saját függvény) vagyis be kell írni a munkafüzeten, ha neked olyan makró kell ami automatikusan kitölti helyetted a többi oszlopokat, akkor az már sub-routine.
Magyar Excel-ben SZÖVEGFELOSZTÁS a függvény neve, lehet hogy csak INSIDER-ben van még.üdv
-
Mutt
senior tag
válasz
andreas49
#48996
üzenetére
Szia,
Tedd be a fájlba a lenti UDF-et, majd használd így:
Function TextPart(InputText, Optional Separator As String = " ", Optional PartStart As Long, Optional PartEnd As Long)
'Separator ha nincs megadva akkor szóközként értelmezzük
Dim arraySplit
Dim vFelsoMeret As Long
Dim i As Long
Dim txtResult As String
'szétszedjük a szöveget az elválasztójel alapján
arraySplit = Split(InputText, Separator)
'megnézzük hogy hány részre szedhető
vFelsoMeret = UBound(arraySplit)
If PartEnd = 0 Then PartEnd = PartStart
'ha az utolsó utáni darabot kérik, akkor is az utolsót adjuk
If PartEnd >= vFelsoMeret + 1 Then PartEnd = vFelsoMeret + 1
'ha a legelső darab előtti kell, akkor is az elsőt adjuk vissza
If PartStart <= 0 Then PartStart = 0
'megadjuk a kért részt
If PartEnd > PartStart Then
txtResult = ""
For i = PartStart To PartEnd - 1
txtResult = txtResult & arraySplit(i - 1) & Separator
Next i
TextPart = txtResult & arraySplit(PartEnd - 1)
Else
TextPart = arraySplit(PartStart - 1)
End If
End Functionüdv
Ps. Microsoft365-ben van már szövegdaraboló függvény is.
-
Mutt
senior tag
válasz
andreas49
#48984
üzenetére
Szia,
Ezt próbáld meg. A kommentek alapján tudod módosítani.
Sub vissza()
Dim wsTOC As Worksheet
Dim ws As Worksheet
Dim i As Long, c As Long
Dim result As Range
Dim back As Range
'a munkalap neve, ahíol megtalálhatók a lapok nevei, ezt javítsd a megfelelőre
Const TOC = "Start"
Set wsTOC = Worksheets(TOC)
'végig futunk a munkalapokon
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
'csak más nevű munkalapok érdekelnek
If ws.Name <> TOC Then
'keressük meg helyét a munkalapnak az összesítőn
Set result = wsTOC.Range("A:A").Find(ws.Name)
'ha nincs meg akkor ugorjuk át
If Not result Is Nothing Then
Set back = ws.Range("A2")
'ha üres lenne a cella akkor írjuk bele ezt, ha nem kell akkor töröld ki
If back = "" Then back = "vissza"
'ha már lenne hivatkozás, akkor töröljük a korábbit
If back.Hyperlinks.Count > 0 Then back.Hyperlinks.Delete
'adjuk hozzá a linket
back.Hyperlinks.Add Anchor:=back, Address:="", SubAddress:="'" & TOC & "'!" & result.Address
End If
End If
Next i
'nem kötelező de szüntessük meg az objektumokat
Set back = Nothing
Set result = Nothing
Set ws = Nothing
Set wsTOC = Nothing
End Subüdv
-
Delila_1
veterán
-
#48740
Fire/SOUL/CD
félisten
andreas49
#48729
válasz
andreas49
#48729
üzenetére
1. Tehát ha jól értem, akkor csak 1 db excel fájl okozza a galibát?
2. Hogy nyitod meg ezt a fájlt, duplaklikk az intézőben rajta és indul az excel vagy Excel-t elindítod, és onnan nyitod meg? Mindkét esetben gond van?
3. Futtasd admin joggal az excel-t és így, az excel-ből próbáld megnyitni, ekkor is összeomlik?
4. elküldheted a LOG fájlt az email címemre(adatlapomon megtalálod), ígérni nem tudok semmit, de belenézek -
#48644
Fire/SOUL/CD
félisten
andreas49
#48643
válasz
andreas49
#48643
üzenetére
Hivatalos forrásból beszerzett Windows és Office van?
Letöltés: Windows 11 | Office (innen is lehet OS-ket tölteni)
Az OS Home vagy Pro?
Az Office pontos verziója? (365/2021/2019 stb)
W10 alá is ugyanazt az Office-t telepíted? (Gondolom igen, de megkérdem)
Az OS-t és az Office-t is frissítsd le naprakészre. -
Delila_1
veterán
válasz
andreas49
#48559
üzenetére
Másold be a makrót egy modulba az Összefoglaló szerint.
Sub Sorbeszuras()Dim sor As Long, usor As Long, lepeskoz As Integerlepeskoz = Application.InputBox("Hány üres sor legyen az adatok között?", "Üres sorok száma", , , , , , 1)usor = Range("A" & Rows.Count).End(xlUp).RowFor sor = usor To 3 Step -1Rows(sor & ":" & sor + lepeskoz - 1).Insert Shift:=xlDownNextEnd Sub -
Pakliman
tag
válasz
andreas49
#48151
üzenetére
Szia!
Egy lehetőség:
=HA(DARABTELI($A$1:A1;A1)=1;SZUMHA(A:A;A1;B:B)/DARABTELI(A:A;A1);"")
Az első DARABTELI-nél FONTOS a $A$1:A1! Ez adja meg a dátum első előfordulását és csak ennél lesz átlag számolva. Természetesen működik e nélkül is.A sorazonosítót nem tudom igazítani. Egy megoldás van, ha az A oszlopban "lehúzod" az =SOR() függvényt majd az A oszlopra beállítod a függőlegesen középre igazítást.
-
Delila_1
veterán
válasz
andreas49
#47425
üzenetére
Lappy válaszán kívül 2 változat:
1. Kijelölöd a módosítható tartományt, és a cellaformázás védelem fülén kiveszed a pipát a zárolás elől, majd lapvédelmet adsz.
2. Alt+F11-gyel belépsz a makró szerkesztőbe. Bal oldalon kiválasztod a lapodat, majd a Properties ablakban (ha nem látszik, F4-gyel láthatóvá teszed) beállítod a ScrollArea (szerkeszthető) területet a kép szerint. Ennél makróbarátként kell mentened a fájlt.
A ThisWorkbook laphoz pedig ez a makró kell:
Private Sub Workbook_Open()Sheets(1).ScrollArea = "$A$1:$H$20"End Sub -
Delila_1
veterán
válasz
andreas49
#47332
üzenetére
Ha nem számként vitted be eleve az adatokat, akkor nem lenne probléma. Azzal, hogy szöveg formátumúra alakítottad a cellákat, még számok maradtak.
Beszúrunk egy sort, ami egyenként szöveggé konvertálja a számokat, így már működni fog.Sub FelsoIndex_1()Dim CV As Object, koztesFor Each CV In Range("E4:AL169")CV = CV & ""If Len(CV) = 2 Then CV.Characters(Start:=2, Length:=1).Font.Superscript = TrueIf Len(CV) = 3 Then CV.Characters(Start:=2, Length:=2).Font.Superscript = TrueNextEnd Sub -
Delila_1
veterán
-
Delila_1
veterán
válasz
andreas49
#47327
üzenetére
Több tételnél ez a makró az utolsó karaktert felső indexbe teszi.
Ebben az esetben azA1:A10tartományban működik.Sub FelsoIndex()Dim kezd As Integer, sor As IntegerFor sor = 1 To 10If Len(Cells(sor, 1)) > 1 Thenkezd = Len(Range("A" & sor))Cells(sor, 1).Characters(Start:=kezd, Length:=1).Font.Superscript = TrueEnd IfNextEnd Sub -
-
Fferi50
Topikgazda
válasz
andreas49
#47243
üzenetére
Szia!
Ezt a makrót másold be egy modulba (vagy a munkalap kódlapjára).Sub kerescserel()
Dim wb As Workbook, ws As Worksheet, mit, mire
On Error GoTo hibas
mit = "": mire = ""
mit = Application.InputBox("Mit cseréljek", "Cserélés", mit)
If mit <> "" And mit <> "False" Then
mire = Application.InputBox("Mire cseréljem a: " & mit & " szöveget?", "Cserélés", mire)
If mire <> "" And mire <> "False" Then
Application.ScreenUpdating = False
For Each wb In Workbooks
For Each ws In Worksheets
ws.UsedRange.Replace what:=mit, replacement:=mire, lookat:=xlWhole
Next
Application.StatusBar = "Cserélem a " & mit & " " & mire & "a(z) " & wb.Name & " munkafüzetben!"
DoEvents
Next
End If
End If
Application.ScreenUpdating = True
Application.StatusBar = False
Exit Sub
hibas:
MsgBox "Hiba van: " & Error
End Sub
Meg kell adnod, hogy mit cseréljen, majd azt, hogy mire szeretnéd cserélni.
A cserélés csak teljes cellatartalomra vonatkozik, részekre nem. Nem érzékeny a kisbetű-nagybetű különbségre.
A makró minden nyitott munkafüzet minden munkalapján cseréli az adott szöveget.
Hozzá rendelheted egy billentyű kombinációhoz, akkor azzal gyorsan tudod hívni - vagy felteheted a menüszalagra is a beállítások - menüszalag - makrók útján.
Ha hibával megáll, akkor jelezz vissza légy szíves.
Remélem, tudod használni.
Üdv. -
Fferi50
Topikgazda
válasz
andreas49
#47241
üzenetére
Szia!
A kérdés az, hogy honnan tudja meg a makró, hogy mit és mire kell cserélni?
A keres/cserél (Ctrl+F) -hez hasonló bevitelre gondolsz vagy kijelölöd egy cellában pl. hogy mit kell cserélni és utána megadod, hogy mire?
(A rész cserélésnek lehetnek buktatói is, pl. ha a jk istván szerűben szeretnéd a jk-t cserélni, akkor előfordulhat, hogy a Majka jk része is "kalapács" - ra cserélődik.
)
Persze minden csere előtt lehet kérdezni is - mint a keres/cserél funkciónál....
Kérdés tehát - hogyan kapja meg a keresési paramétereket a makró?
Üdv. -
Delila_1
veterán
válasz
andreas49
#47212
üzenetére
=HA(INDIREKT("'"&A1&"'!$Y$162")>INDIREKT("'"&A1&"'!$Y$163");INDIREKT("'"&A1&"'!$S$162");INDIREKT("'"&A1&"'!$S$163"))A1-ben van a lap neve, azt folytathatod lefelé.
Az volt a bibi, hogy a lapnevet aposztrófok közé kell tenni. '2021'! plusz cellacím.
A képletnél úgy látszik, mintha az idézőjelek és aposztrófok között szóköz lenne, de nincs.Csatolok egy képet.
-
-
Fferi50
Topikgazda
válasz
andreas49
#47160
üzenetére
Szia!
Ha jól értelmezem a kérdést, akkor a javaslatom a következő:
Egy segédoszlop első cellájába, ahol az adatok kezdődnek, írd be a mellette levő adatot.
Ezután a második cellában a képlet:
=Ha(A2="";B1;A2)
Ez húzható lefelé.
Ezután a segédoszlopot másolod, irányított beillesztés értéket ugyanoda - vagy az első oszlopra. Majd az első oszlopot/vagy a segédoszlopot törlöd - attól függően, hova illesztetted be az értéket.
Üdv. -
-
lappy
őstag
válasz
andreas49
#47097
üzenetére
Minden képlet
https://support.microsoft.com/hu-hu/office/a-k%C3%A9pletek-megjelen%C3%ADt%C3%A9se-%C3%A9s-kinyomtat%C3%A1sa-65a29965-b1b1-40db-9cb7-4fd051da3a5c
Csúszka
https://support.microsoft.com/hu-hu/office/g%C3%B6rget%C5%91s%C3%A1vok-elrejt%C3%A9se-vagy-megjelen%C3%ADt%C3%A9se-a-munkaf%C3%BCzetben-2101e630-fa9b-4d22-90e0-b110278bafa7 -
smnetbp
csendes tag
válasz
andreas49
#47075
üzenetére
Ha utana a Table1 - Table15 ig kitorlom, akkor mar a tulajdonsagainal ugy jelenik meg mint " csak kapcsolodas" es a hozzafuzes1 rendben mukodik tovabb es a tobbi nem jelenik meg tobbe. Viszont ez problema lehet tobb 100 erdemenyul kapott "table" eseteben, mert egyesevel kitorolni........ kicsit DOS 1.0 erzesem van
Tehat szerintem a Power Query -ben lehetne talan ezt beallitani ha Excel guru lennek -
Pakliman
tag
válasz
andreas49
#46956
üzenetére
Szia!
Egy lehetőség...
Az sPath mappában lévő összes *.xls* fájlon végigmegy.
Megnyitja a fájlt, a benne lévő munkalapokon megkeresi és kicseréli az összes sMit (cserélendő) szöveget az sMire szövegre majd bezárja MENTÉSSEL a megnyitott táblázatot.Sub x()
Const sPath As String = "d:\_Egyéb\"
Dim sName As String
Dim sFullName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim sAddr1 As String
Dim sMit As String
Dim sMire As String
sMit = "keresendő szöveg"
sMire = "erre cseréljük"
sName = Dir(sPath & "*.xls*")
Do Until sName = ""
sFullName = sPath & sName
Set wb = Workbooks.Open(Filename:=sFullName)
For Each ws In wb.Worksheets
With ws.Cells
Set r = .Find(What:=sMit, LookIn:=xlValues, LookAt:=xlPart)
If Not r Is Nothing Then
sAddr1 = r.Address
Do
r.Value = Replace(r.Value, sMit, sMire)
Set r = .FindNext(r)
Loop While Not r Is Nothing
End If
End With
Next ws
wb.Close SaveChanges:=True
sName = Dir
Loop
End Sub -
föccer
nagyúr
válasz
andreas49
#46956
üzenetére
Ha jól értem akkor az összes vezétés/keresztnév párosítást ki kell egyelni, hogy mindenből csak 1 szerepeljen?
ha csak egyszer kell megcsinálni, akkor lehet egyszerűbb ha összevágod 1 munkalapra a teljes adattáblát, összefűzöd a vezeték és keresztneveket, majd használd az adatok/azonosak eltávolítását (lehet nem pontos a név)
Macerás, összerajni egy munkalapra, de billentyűzetről gyorsan be lehet tanulni a mozdulatsort. A1 kijelölve, ctrl+END-el adatsor vége, ctrl+C másilás, Alt+tab-al átlépsz arra ahol össze fűzöd az adatokat. ctrl+ lefele nyíllal lépz az urolso sorra, majx ctrl+v-vel beszúrsz. Ha begyakorolod, akkor pár 10 másodpercenként meglehetsz 1-1 munkalappal. Kicsit unalmas, de 1-2 óra altt le lehet darálni. Én sokszor lusta vagyok makrózni.
üdv, föccer
-
belinho
senior tag
válasz
andreas49
#45935
üzenetére
Köszi!
Gondoltunk már erre, de ezt nem lehet szerkeszteni, csak megnézni.
2003 esetén volt anno valami converter, amivel meg tudtuk anno nyitni az újabbal készült dokumentumokat szinte átalakítás nélkül. 2007-hez nincs esetleg valami ilyesmi?
Szinte minden használható volt eddig, azért a néhány dokumentumért nem nyugdíjaznánk, bár tényleg koros már. -
ny.janos
tag
válasz
andreas49
#45857
üzenetére
Lappy javaslatát (eredmény típusa: 21) próbáltad? (Office 365-öm nincs, de 2019-ben hiba nélkül működik, míg az 1-es vagy 2-es típus a 2019-es excelben is azt az eredményt adja, amit te írtál).
Egyébként létezik az ISO.HÉT.SZÁMA függvény is, ott nem kell eredmény típusát megadnod.
-
Fferi50
Topikgazda
válasz
andreas49
#45836
üzenetére
Szia!
A kimutatásnál oszlopcimkének beviszed a Dátumot - ekkor automatikusan megjelenik az év és a negyedév is. A negyedévet lenyitva ott találod a mező törlése opciót. Kitörlöd.
Majd a Dátum mezőt átviszed a sorcimkékhez.
Ezután a bevétel-kiadás mezőt beteszed az értékekhez.
A mezők nevét át tudod írni a mezőbeállításoknál.
Üdv. -
Fferi50
Topikgazda
válasz
andreas49
#45619
üzenetére
Szia!
Mi vele a problémád?
Ha a cimkék összeérése a gond, akkor pl. megváltoztathatod a tengelyen a mértékegységet:
Tengely formázása - Nagyságrend. Itt kiválaszthatod hogy milyen legyen a megjelenés.
Ezen kívül meg lehet oldani, hogy minden másodikhoz legyen cimke, esetleg váltogatni lehet a megjelenés helyét - egyik felül, másik alul vagy középen.
Üdv. -
Fferi50
Topikgazda
válasz
andreas49
#45440
üzenetére
Szia!
Kijelölöd a kimutatás alá és elé eső első cellát. Pl kimutatás vége H8, akkor az I9 cellát.
Ezután Nézet-Panelek rögzítése - Ablaktábla rögzítése.
Ebben az esetben az A-I oszlop és felső 8 sor mindig látható, a többi görgethető.
Számolj azzal. ha a rögzített oszlopok nem férnek el a képernyőn, akkor nem láthatod az elől levő oszlopokat láthatóvá görgetni.
A görgetés csak a rögzített cellától lefelé és jobbra működik.
Próbáld ki, aztán eldöntöd, hogyan kell elhelyezni a kimutatást a munkalapon, hogy jó legyen a görgetés.
A rögzítést ugyanezen az úton tudod megszüntetni az Ablaktábla feloldása menüponttal.
Üdv.
Üdv. -
lappy
őstag
válasz
andreas49
#45062
üzenetére
Itt van egy ilyen kód amire szükséged van
Sub InsertRowsAtCursor()
Answer = InputBox("How many Rows to insert? (50 Rows maximum)")
NumLines = Int(Val(Answer))
If NumLines > 50 Then
NumLines = 50
End If
If NumLines = 0 Then
GoTo EndInsertLines
End If
Do
Selection.EntireRow.Insert
Count = Count + 1
Loop While Count < NumLines
EndInsertLines:
End Sub -
Fferi50
Topikgazda
válasz
andreas49
#40498
üzenetére
Szia!
Ha azt szeretnéd, hogy növekvő "névsor" szerint legyenek az értékek, akkor a H oszlop képletében ne + hanem - jelet használj:
=F5+SOR()*0,0001 helyett =F5-SOR()*0,0001A formázást vagy makróval lehet átvinni vagy feltételes formázási szabályokat alkotsz megfelelő feltételekkel pl. cellák formázása képlet alapján.
Üdv.
-
Delila_1
veterán
-
Mutt
senior tag
válasz
andreas49
#39686
üzenetére
Szia,
Tömbfüggvénnyel a megoldás az általad vázolt problémára:
=SZÖVEGÖSSZEFŰZÉS(", ";1;HA(DARABTELI(B2:AA2;SOR($A$1:$A$13)-1);SOR($A$1:$A$13)-1&"="&DARABTELI(B2:AA2;SOR($A$1:$A$13)-1);""))
Ha betűket (A-Z) akarsz megszámolni, akkor ez a képlet (B8:AA8 a tartomány ahol számolni kell):
=SZÖVEGÖSSZEFŰZÉS(", ";1;HA(DARABTELI(B8:AA8;KARAKTER(64+SOR($A$1:$A$27)));KARAKTER(64+SOR($A$1:$A$27))&"="&DARABTELI(B8:AA8;KARAKTER(64+SOR($A$1:$A$27)));""))üdv
)
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
Fferi50- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- MS SQL Server 2016, 2017, 2019
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- ÚJ Bontatlan Honor X7d 6/128GB fekete/ 12 hónap jótállással!
- Alienware 17r4 olvass
- 146 - 147 - 167 - 168 - 169 - Lenovo Legion Pro 7 (16IRX9H) - Intel Core i9-14900HX, RTX 4090
- Beszámítás! Sony PlayStation 5 825GB SSD Digital konzol extrákkal garanciával hibátlan működéssel
- AKCIÓ! LENOVO ThinkPad P15 Gen 2 munkaállomás - i7 11850H 16GB DDR4 1TB SSD RTX A2000 4GB W11
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest