-
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
-
lappy
őstag
válasz
MasterMark
#49569
üzenetére
Akkor ezt nezd meg
-
Fferi50
Topikgazda
válasz
MasterMark
#49567
üzenetére
Szia!
Ez a mondat:
"Miegegyszer mondom, hogy nem fogom kezzel atalligtani egyesevel.
"
kiakasztott egy kicsit.
Próbáltunk ötleteket adni, de a probléma pontosabb ismerete nélkül nehéz eltalálni, mit is szeretnél tkp.
Ezért javasoltam a minta fájl közzétételét.
És sajnos néha nincs más, mint kézzel átírni (mert még makrón sem érdemes gondolkodni), a makróhoz pedig kellenek az infók.
Remélem, sikerül megoldanod a problémát.
Üdv. -
Mutt
senior tag
válasz
MasterMark
#49563
üzenetére
Szia,
Egy próba fájlon próbáld ki ezt a makrót.
Csak pontos egyezés esetén cseréli a képletben az első találatot (Count:=1 -et törölve ez a korlátozás megszűnik) pontossan arra amit megadtál.Sub UpdateRangeInFormulas()
Dim ws As Worksheet
Dim rng As Range
Dim rngFormulas As Range
Dim mit As String
Dim mire As String
Dim keplet As String
mit = Application.InputBox(Prompt:="Mit cseréljünk?", Title:="Keresendõ", Default:="A1:A10", Type:=2)
mire = Application.InputBox(Prompt:="Mire cseréljük?", Title:="Új érték", Default:="A1:A11", Type:=2)
For Each ws In ThisWorkbook.Worksheets
Set rngFormulas = Selection.SpecialCells(xlCellTypeFormulas, 23)
For Each rng In rngFormulas
keplet = rng.Formula2
If InStr(1, keplet, mit) > 0 Then
rng.Formula2 = Replace(keplet, mit, mire, Count:=1)
End If
Next rng
Next ws
End Subüdv
-
Fferi50
Topikgazda
válasz
MasterMark
#49563
üzenetére
Szia!
Irónia on:
Esetleg kiadhatnád valakinek, aki jó pénzért biztosan szívesen megcsinálja az átalakításokat
Irónia off
Talán meg lehetne beszélni a forrás előállítójával, hogy komfortosabb formában adja meg számodra az adatokat.
Egyébként pedig makró a legegyszerűbb megoldás, lehet paraméterezni is.
Ha felteszel valahova egy mintát - valós szerkezettel, légből kapott adatokkal - akkor biztosan lesz itt valaki, aki csinál egy használható makrót rá.
Sajnos nem vagyunk (még) gondolatolvasók.
Üdv.
Üdv. -
lappy
őstag
válasz
MasterMark
#49561
üzenetére
Akkor konvertald át a hivatkozást majd beszúrsz egy sort es visszalakítod
-
Delila_1
veterán
válasz
MasterMark
#49561
üzenetére
-
Fferi50
Topikgazda
válasz
MasterMark
#49557
üzenetére
Szia!
Ha A1:A10 esetén plusz sort szeretnél hozzáadni, akkor ne A11-be írd az új értékeket, hanem szúrj be egy sort a 10 sor elé. Az így hozzáadott sor miatt automatikusan módosul az A1:A10 -re hivatkozó képlet A1:A11-re.
Talán tudod használni ezt (is).
Üdv. -
Delila_1
veterán
válasz
MasterMark
#49555
üzenetére
Nem szükséges makró. Formázd az adataidat táblázatként.
Vegyük, hogy a B oszlopban számadatok vannak, az oszlop címe Összeg.
A következő (C) oszlopban a B oszlop értékeit fel akarod szorozni 3-mal.
A C2 képlete =[@Összeg]*3
Amint bővíted a táblázatodat, a C oszlop képlete automatikusan beíródik az új sorba. -
Fferi50
Topikgazda
válasz
MasterMark
#41687
üzenetére
Szia!
Azon kívül, amit Delila írt, fontos még, hogy az idézőjeleket a képletben párosával kell írni, ha valóban idézőjelet szeretnél ott kapni.
A képleted helyesen:Sheets("egyéni").Range("A1").Formula ="=RIGHT(CELL(""filenév"",A1),LEN(CELL(""filenév"",A1))-SEARCH(""]"",CELL(""filenév"",A1))) & ""("" & FLOOR(SUMPRODUCT((NOT(ISBLANK(J3:J1002))*(1/COUNTIF(J3:J1002,J3:J1002 &"""")))),1) & "" darab)"""(Sőt, még a filenév helyett is a filename az igazán helyes, de csodával határos módon ezt érti az Excel).
Van viszont egy olyan lehetőség is, hogy magyar nyelven add meg a képletet a makróban, ezt a FormulaLocal tulajdonsággal lehet megtenni. Ennek az a hátránya, hogy csak a magyar Excelben érti meg a VBA, más nyelvterületen nem, azaz a munkafüzet nem hordozható.
Természetesen az idézőjelekre ebben az esetben is oda kell figyelni.Üdv.
-
Delila_1
veterán
válasz
MasterMark
#41688
üzenetére
Makróban a függvények angol nevét kell megadnod.
-
MasterMark
titán
válasz
MasterMark
#41687
üzenetére
Maga a képlet jó, egy cellából másoltam ki.
-
Delila_1
veterán
válasz
MasterMark
#41637
üzenetére
Az eredeti kérdésedből nem feltételeztem az ilyen irányú ismereteidet, mert nem akartad megadni, melyik oszlop szerint kell a szűrést végrehajtani, holott ezt alapvető ebben az esetben. Ha tudom, hogy értesz hozzá, másképp segítettem volna.
-
Delila_1
veterán
válasz
MasterMark
#41633
üzenetére
Félreértettem. Azt hittem, cellán belül nem jó helyről tüntettem el a szóközöket.
Így legalább "megszakértetted", és javítani is tudtad.Sok sikert a további makrózáshoz!
-
MasterMark
titán
válasz
MasterMark
#41634
üzenetére
Ja megvan a tied mintajara. Koszi.
-
Delila_1
veterán
válasz
MasterMark
#41630
üzenetére
"a sortolást nem jó helyről kezdte", mert nem adtad meg.

Autoszűrő, sorszámozás, és formátum a lapokra:
Sub AutSzuro_Sorszam_Formatum()
Dim lap As Integer
For lap = 1 To Sheets.Count
Sheets(1).Range("A:J").Copy
Sheets(lap).Range("A:J").PasteSpecial xlPasteFormats
Sheets(lap).Range("A2").AutoFilter
Sheets(lap).Range("A3" & ":A" & Range("A3").End(xlDown).Row) = "=row()-2"
Next
End Sub -
Delila_1
veterán
válasz
MasterMark
#41625
üzenetére
Sub Szortirozas()
Dim usor As Long, sor As Long, lapnev As String
Dim innen As Long, eddig As Long, ide As Long, ujnev As String
'Rendezés album szerint
Sheets("Munka1").Select
usor = Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add2 Key:=Range("J3:J" & usor), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A1:J" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Másolás új lapokra
sor = 3
Do While Cells(sor, 10) <> ""
lapnev = Cells(sor, 10)
If Application.WorksheetFunction.CountIf(Columns(10), lapnev) > 1 Then
ujnev = Application.WorksheetFunction.Substitute(lapnev, " ", "")
ujnev = Left(ujnev, 30)
Sheets.Add.Name = ujnev
Sheets("Munka1").Select
Rows("1:2").Copy Sheets(ujnev).Range("A1")
innen = sor
eddig = Application.WorksheetFunction.Match(lapnev, Columns(10), 1)
ide = Sheets(ujnev).Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & innen & ":J" & eddig).Copy Sheets(ujnev).Range("A" & ide)
Sheets(ujnev).Range("A1") = ujnev
sor = eddig + 1
Else
sor = sor + 1
End If
Loop
Sheets("Munka1").Move Before:=Sheets(1)
MsgBox "Kész van az albumonkénti szortírozás", vbInformation, "Információ"
End Sub -
Delila_1
veterán
válasz
MasterMark
#41623
üzenetére
Modulba másold a lenti makrót (lásd a Téma összefoglalóban). A makróban a Munka1 nevet mindenhol írd át a saját lapod nevére.
Sub Szortirozas()
Dim usor As Long, sor As Long, lapnev As String
Dim innen As Long, eddig As Long, ide As Long
'Rendezés album szerint
Sheets("Munka1").Select
usor = Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add2 Key:=Range("J3:J" & usor), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A1:J" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Másolás új lapokra
sor = 3
Do While Cells(sor, 10) <> ""
lapnev = Cells(sor, 10)
If Application.WorksheetFunction.CountIf(Columns(10), lapnev) > 1 Then
Sheets.Add.Name = lapnev
Sheets("Munka1").Select
Rows("1:2").Copy Sheets(lapnev).Range("A1")
innen = sor
eddig = Application.WorksheetFunction.Match(lapnev, Columns(10), 1)
ide = Sheets(lapnev).Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & innen & ":J" & eddig).Copy Sheets(lapnev).Range("A" & ide)
Sheets(lapnev).Range("A1") = lapnev
sor = eddig + 1
Else
sor = sor + 1
End If
Loop
Sheets("Munka1").Move Before:=Sheets(1)
MsgBox "Kész van az albumonkénti szortírozás", vbInformation, "Információ"
End Sub -
Delila_1
veterán
válasz
MasterMark
#41621
üzenetére
Az titok, hogy melyik oszlopod tartalmazza a nevet? Az is kell, hogy összesen hány oszlopod van, pl. A-tól
G-ig. -
Delila_1
veterán
válasz
MasterMark
#41618
üzenetére
Ennél azért egy kicsit többet kellene tudnunk.
Egyszer, vagy ritkán kell szétbontani az adatokat, esetleg rendszeresen? Mekkora mennyiségről van szó? Hány féle adat van a szűrendő oszlopban?Első esetben szűröd az oszlopot 1-1 tételre, majd a szűrt állományt másolod (áthelyezed) az új lapra.
A második esetben érdemes makrót írni rá, de ahhoz is legalább annyit kell ismernünk, hogy melyik oszlop szerint kell szűrni, másolni vagy áthelyezni kell az adatokat.
-
Delila_1
veterán
válasz
MasterMark
#13660
üzenetére
Ha az A1 cellában van a születési dátum, a képlet =MA()-A1. A képletet tartalmazó cella formátuma általános, vagy szám formátumú legyen.
Új hozzászólás Aktív témák
- Hobby elektronika
- Elektromos autók - motorok
- Szívós, szép és kitartó az új OnePlus óra
- Anglia - élmények, tapasztalatok
- Folyószámla, bankszámla, bankváltás, külföldi kártyahasználat
- Kamionok, fuvarozás, logisztika topik
- Revolut
- Nem is gondolnád, hogy milyen komplex külső akkut gyártani
- Elemlámpa, zseblámpa
- Kertészet, mezőgazdaság topik
- További aktív témák...
- REFURBISHED és ÚJ - HP USB-C/A Universal Dock G2 (5TW13AA) (DisplayLink)
- GYÖNYÖRŰ iPhone 12 mini 256GB Blue -1 ÉV GARANCIA -Kártyafüggetlen, MS3625
- Telefon felvásárlás!! Samsung Galaxy S25, Samsung Galaxy S25 Plus, Samsung Galaxy S25 Ultra
- GYÖNYÖRŰ iPhone 13 256GB Midnight -1 ÉV GARANCIA - Kártyafüggetlen, MS3205
- Eredeti Lenovo 65W USB Type C notebook töltő
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Promenade Publishing House Kft.
Város: Budapest
"


Fferi50
