-
Mobilarena
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
-
Mutt
senior tag
válasz
Salex1
#49623
üzenetére
Szia,
Makrós megoldást kaptál, itt egy Power Query-s (PQ).
1. Legyen egy táblázatban az adatsorod.
2. Adatok -> Táblázatból/Tartományból beszúrással bekerül PQ szerkesztőbe a lista.
3. A minta nem követte a 2-5-5-8-6-os logikát, azért inkább azt csináltam hogy kötőjelenként felosztottam, majd utána újra előállítottam a helyes adatokat. Kezdőlap -> Oszlop felosztása opciót használd.
4. Ez után lesz egy automatikus típus konverzió lépés, amelyet jobb oldalt a lépések listából érdemes törölnőd.
5. Állítsuk elő az általad kívánt azonosítókat. Jelöld ki az első és második oszlopot, majd Átalakítás -> Oszlopok egyesítése kell. Én ID1 nevet adtam az új oszlopnak.
6. Jelöld ki az újonnan létrehozott és a következő oszlopot, majd Oszlopok hozzádása -> Oszlopok egyesítése. Én ID2-nek neveztem az új oszlopot.
7. Még kell 2 újabb oszlop egyesítés, mindig a frissen létrehozott oszlophoz fűzve a szükségeset.
Vmi ilyen eredmény lesz.
8. Jelöld ki az ID1, ID2, ID3, ID4 oszlopokat, majd Kezdőlap -> Oszlopok eltávolítása -> További oszlopok eltávoltása menűvel töröljük a felesleges oszlopokat.
9. Jelöld ki az ID4 oszlopot, majd Kezdőlap -> Csoportosítási szempont opcíót álltsd így be.
10. Oszlop hozzáadása -> Egyéni oszlopot válaszd, a képlet legyen ez:=List.Combine({[Adatok][ID1],[Adatok][ID2],[Adatok][ID3],[Adatok][ID4]})
Egy kis magyarázat ehhez: a 9-es lépésben minden sorhoz hozzárendeltük a hozzátartozó, magasabb szintű azonosítókat. Ezeket nyerjük ki a fenti képlettel. PQ-ben több típus van (record, list, table). Record egy mező, ami nem jó nekünk, a list több record, amelyeket sorokba/oszlopokba tehetünk, a table pedig egy táblázat, ami megint nem lesz jó nekünk a megoldáshoz.
11. Az új oszlop fejlcében a jobb oldali ikonra kattinva válaszd a sorokba bontást.
12. Töröld a másik két oszlopot, nem kellenek már.
13. Vegyük ki az ismétlődéseket: Kezdőlap -> Sorok eltávolítása -> Ismétlődések eltávolítása
14. Töltsük vissza Excelbe a végeredményt, Kezdőlap -> Bezárás és betöltés.üdv
-
#49628
Fire/SOUL/CD
félisten
Salex1
#49627
válasz
Salex1
#49627
üzenetére
Az első cellát vélem Én hibásnak, mert nincs azonosítója (hiányzik a végéről), egyáltalán nem mindegy, hogy ilyen cella/cellák is van/vannak avagy sem.
Addig is írtam egy makrót, ami most hibásnak vél ilyen cellá(ka)t és kérésre kihagyja a feldolgozását, ez az eredménye a futtatásának.
Azért nem teszem be a kész makrót még, mert ha véletlenül az a cella nem hibás (itt a példában az A2 cella), akkor módosítanom kell a makrón....
(most viszont egy gépet kell összepakolnom, csak 6-7 órakor érek rá vele foglalkozni, addigra meg lehet, hogy dobnak be mások is megoldásokat) -
#49624
Fire/SOUL/CD
félisten
Salex1
#49623
-
#49033
Fire/SOUL/CD
félisten
Salex1
#49032
-
-
#49029
Fire/SOUL/CD
félisten
Salex1
#49027
-
Mutt
senior tag
válasz
Salex1
#48995
üzenetére
Szia,
Itt az én változatom a felosztásra:
Sub Atrendez()
Dim wsCel As Worksheet
Dim adatok, bont, aktualis()
Dim c As Long, i As Long
Dim oszlopok As Long, oszlopBont As Long
Dim sor As Long
Dim ertekek As String
'erre a munkalapra másoljuk az értékeket
Const cel = "Munka2"
'ezen nevú oszlopot kell sorokba bontani
Const bontani = "AH"
'a fenti oszlopnevet számmá alaktjuk
oszlopBont = Cells(1, bontani).Column
'beolvassuk a teljes adatsort
adatok = ActiveSheet.Range("A1").CurrentRegion
oszlopok = UBound(adatok, 2)
'cél munkalap beállítása
Set wsCel = Worksheets(cel)
'esetleg létező adatok törlése a cél munkalapról
wsCel.Cells.Clear
'erre szükség lehet a 11ezer sor kiírásakor
Application.ScreenUpdating = False
sor = 1
'végig megyünk a beolvasott adatokon
With wsCel
For c = 1 To UBound(adatok)
'egy átmeneti tömbbe (aktualis) beolvassuk az adatokat soronként
ReDim aktualis(1 To oszlopok)
For i = 1 To oszlopok
aktualis(i) = adatok(c, i)
Next i
'a bontani kívánt oszlopot feldolgozzuk, előtte levesszük a [ és ] jeleket
ertekek = Replace(Replace(aktualis(oszlopBont), "[", ""), "]", "")
bont = Split(ertekek, "','")
'ha üres volt a bontani kívánt érték akkor csak 1 sort kell írnunk
If UBound(bont) < 0 Then
.Cells(sor, 1).Resize(, oszlopok) = aktualis
sor = sor + 1
Else
'ha nem volt üres akkor visszont ismételni kell egymás után a dolgokat
For i = 0 To UBound(bont)
.Cells(sor, 1).Resize(, oszlopok) = aktualis
.Cells(sor, oszlopBont) = Replace(bont(i), "'", "")
sor = sor + 1
Next i
End If
Next c
End With
Application.ScreenUpdating = True
End Subüdv
-
Delila_1
veterán
válasz
Salex1
#48989
üzenetére
A belinkelt képen a szétválasztandó adatok a D oszlopban voltak, eszerint írtam meg a makrót. Nem véletlenül került be az Összefoglalóba, hogy
– Ne azt írd, hogy például az A oszlop szűrt adatait szeretnéd a C oszlopba másolni, ha valójában a B oszlop szűrt adatai kellenek egy másik lap X oszlopába.
Ha nem eszerint jársz el, dupla munkát okozol annak, aki szívességet tesz neked.
Most sem pontos a kérésed. Nem szerepel benne, hogy a kép szerinti A-B-C és E oszlopok adatai hol szerepelnek a lapodon. -
Delila_1
veterán
válasz
Salex1
#48857
üzenetére
A mintád alapján írtam egy makrót, ami a Munka2 lapra írja az első kép adatait a második képed szerint . A makrót modulba másold, a füzetet makróbarátként kell elmentened.
Sub Atrendez()Dim oszlop As Integer, uoszlop As Integer, ide As Long, sor, usor As LongRange("V:BB").ClearContentsSheets("Munka2").Range("A:E").ClearContentsusor = Range("E" & Rows.Count).End(xlUp).RowRange("D1:D" & usor).Copy Range("V1")With Range("V1:V" & usor).Replace What:="W", Replacement:=",0".Replace What:=",0", Replacement:="W".Replace What:="[", Replacement:="".Replace What:="]", Replacement:="".Replace What:="'", Replacement:="".TextToColumns Destination:=Range("V1"), Comma:=TrueEnd WithRange("V1", ActiveCell.SpecialCells(xlLastCell)).SelectSelection.Replace What:="W", Replacement:=",0"Cells(1).Selectide = 1For sor = 1 To usoruoszlop = Cells(sor, Columns.Count).End(xlToLeft).ColumnWith Sheets("Munka2")For oszlop = 22 To uoszlopRange("A" & sor & ":C" & sor).Copy .Range("A" & ide).Range("D" & ide) = Cells(sor, oszlop).Range("E" & ide) = Cells(sor, "E")ide = ide + 1NextEnd WithNextRange("V:BB").ClearContentsSheets("Munka2").SelectCells(1).SelectEnd Sub -
#48855
Fire/SOUL/CD
félisten
Salex1
#48853
-
Fferi50
Topikgazda
válasz
Salex1
#46330
üzenetére
Szia!
" tele van valami nemlátható, örökölt szeméttel. "
Erre az esetre sajnos nem jó még a másolás - beillesztés értékként sem, mivel ugyanúgy visszamásolja a "szemetet", a nem látható karaktereket is.
Próbáld meg a TISZTÍT függvényt, egy másik munkalapra másolva az értékeket:
=TISZTÍT(Munka1!A1)
Ez húzható oldalra és lefelé is.
Utána ezen a munkalapon másolás- irányított beillesztés értékként.
Talán segíthet.
Üdv. -
Fferi50
Topikgazda
válasz
Salex1
#38486
üzenetére
Szia!
Az miért nem opció, hogy beírod a rengeteg dátumodat vesszőkkel, majd a Ctrl+F funkcióval kicseréled a vesszőket pontra? Ha kijelölöd az egész oszlopot, akkor ez egy menetben megvan.
Vagy makróval, eseménykezeléssel, ezt a makrót írd be a munkalap kódlapjára (jobb egérgomb a fülön, kód megjelenítése):Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub 'ide azt az oszlopszámot tedd az 1 hely?re, ahova a dátumot írod
Application.EnableEvents = False
Target.Value = Replace(Target.Value, ",", ".")
Application.EnableEvents = True
End SubUtána makróbarát füzetként kell mentened.
Üdv.
-
Fferi50
Topikgazda
válasz
Salex1
#33300
üzenetére
Szia!
Ha képként mented el, akkor bármivel meg lehet nézni és képként be is lehet importálni munkalapra is
Egyébként visszafelé nem kompatibilis egyetlen Excel verzió sem, a fejlesztéseket nem lehet a korábbi verziókban használni, azok hibát okoznak.
Azért nézd meg lsz. hogy a 2010-es Excelben nincs-e benne már a saját kombinációs lehetőség (2013-as verzióban van), mivel én azt már nem tudom megnézni.Üdv.
-
-
Mittu88
senior tag
válasz
Salex1
#30773
üzenetére
Kell a Set szó elé. Set Wb=Workbooks.Open(Filename:="K:\példa.xls")
Elfelejtettem írni, hogy zárójel kell.Module1-be úgy tudod átvinni, ha Module1-ben deklarálod a változót, pl Public teksztbokszertek as String, majd Munka1-en Private Sub textbox_Exit(ByVal cancel As MSForms.ReturnBoolean) eseménybe beírod, hogy teksztbokszertek = textbox.value (ha elhagyod a textbox-ot, akkor kap értéket a változó)
De írhatod a Private Sub textbox_Change() eseménybe is (ekkor minden karakterváltozáskor lefut az értékadás a változónak). -
Mittu88
senior tag
-
bteebi
veterán
válasz
Salex1
#21457
üzenetére
Sub osszefuz()
Dim i As Integer, lastrow As Integer
lastrow = Range("B" & Rows.Count).End(xlUp).Row
Range("K1") = ""
For i = 1 To lastrow
If Cells(i, 13).Value = True Then
Range("K1") = Range("K1") & Cells(i, 2).Value & ", "
End If
Next i
Range("K1") = Left(Range("K1"), Len(Range("K1")) - 2)
End Sub -
Delila_1
veterán
válasz
Salex1
#21084
üzenetére
Igen, a gomb click eseményébe csak ennyit kell írnod: auto_open.
A lenti makró működik gombról.Sub masol()
Dim sor As Long, usorR As Long, usorM As Long
Dim WSR As Worksheet, WSM As Worksheet
Set WSR = Sheets("Rendszerek")
Set WSM = Sheets("Munkák")
usorR = WSR.Range("A" & Rows.Count).End(xlUp).Row
usorM = WSM.Range("B" & Rows.Count).End(xlUp).Row + 1
For sor = 2 To usorR
If WSR.Cells(sor, "O") = 1 Then
WSM.Cells(usorM, "B") = WSR.Cells(sor, "C").Value
WSM.Cells(usorM, "H") = WSR.Cells(sor, "H").Value
WSM.Cells(usorM, "G") = "Terv"
WSR.Cells(sor, "O") = "áttéve"
usorM = usorM + 1
End If
Next
WSM.Range("A1").AutoFilter Field:=7, Criteria1:="<>kész"
End Sub -
Delila_1
veterán
válasz
Salex1
#21066
üzenetére
Úgy látom, túlbonyolítottad, és elég rosszul látszik a makró. Ha a bemásolás után kijelölöd a szöveget, majd a Programkód gombra kattintasz, látható lesz, és a tagolások sem tűnnek el, átláthatóbb lesz, jobban lehet értelmezni.
Nagyjából azt vettem ki, hogy a Rendszerek lapról azoknak a soroknak bizonyos értékeit kell átmásolnod a Munkák lap első üres sorába, ahol az O oszlopban 1-es érték van. Ezután az O oszlop kérdéses sorába "Áttéve" szöveget íratsz, a G-be "Terv"-et.
Add meg, melyik oszlopok értékeit kell másolni a Munkák lap melyik oszlopaiba (pl. a H-t a H-ba).
-
-
Delila_1
veterán
válasz
Salex1
#20462
üzenetére
Jó lett volna, ha látszanak a sor- és oszlopazonosítók. Úgy tippelem, hogy a jan.1. a B2 cellában van, a febr.1. pedif az F2-ben.
A laphoz kell rendelned a makrót.
Private Sub Worksheet_Activate()
Dim nap As Integer, honap As Integer
nap = Day(Date) + 1
Select Case Month(Date)
Case 1
honap = 2 'B oszlop
Case 2
honap = 6 'F oszlop
End Select
Cells(nap, honap).Select
End SubFolytatsd a Case utasítást 12-ig. A hónap mindig annak az oszlopnak a száma legyen, ahova az ahavi adatok kerülnek.
-
Salex1
őstag
válasz
Salex1
#20459
üzenetére
Rátaláltam, de ha kellene másnak is az adott időpontban való makró futtatás:
Bele kell írni egy bármilyen makróba (pl. auto_open), amit lefuttatva már a memóriába kerül és ez után már végre fogja hajtani az adott időpontban.Application.OnTime TimeValue("8:00:00"), "Makró név"
-
Delila_1
veterán
válasz
Salex1
#20386
üzenetére
A textbox tulajdonságainál add meg a LinkedCell értéknek pl. az L1-et.
Duplaklikk a textboxra, a kódlapon megkapod a change esemény első és utolsó sorát.Egyetlen sort kell közéjük írni:
Selection.AutoFilter Field:=2, Criteria1:=Range("L1") & "*"
Az autoszűrő a textboxba bevitt karakterek szerint szűr. Az első karakter beírására az összes adat látszik, ami azzal a karakterrel kezdődik. A második karakter leütésére a két bevitt karakterrel kezdődő adatok jelennek meg.
-
Delila_1
veterán
válasz
Salex1
#20386
üzenetére
Nem néztem kellő figyelemmel a haloványan bevitt makródat, amiből kiderül, hogy nem külön userformon, hanem a füzet egy lapján van a textbox. Ebben az esetben a textboxon jobb klikk, makró hozzárendelése. Megjelenik a makróidat tartalmazó párbeszéd ablak, ahonnan kiválasztod a megfelelőt.
-
Delila_1
veterán
válasz
Salex1
#20390
üzenetére
Duplaklikk a textboxon. Ad egy makrót Private Sub TextBox1_Change() címmel, és End Sub-bal. A lap tetején jobbra a legördülőben a Change esemény látszik, ahelyett kiválasztod az AfterUpdate eseményt. A Sub és End Sub sorok közé másolod át a kész makródat, a Change eseményhez adott két sort törölheted.
-
Delila_1
veterán
válasz
Salex1
#20355
üzenetére
Rögzíts egy makrót úgy, hogy "gyalog" beviszed a kritériumot a megfelelő oszlophoz, majd a makróban írd át a feltételt a szövegdoboz értékére. Criteria1:=TextBox1.Text
Ilyesmi lesz:
Dim tartomany As Range
Set tartomany = Range("A1:D12")
tartomany.AutoFilter Field:=1, Criteria1:=TextBox1.TextItt a megadott tartomány első oszlopát (Field:=1) szűrtem.
-
Delila_1
veterán
-
#19238
Fire/SOUL/CD
félisten
Salex1
#19237
-
Delila_1
veterán
válasz
Salex1
#17606
üzenetére
cells(1,3).copy
range("A5").select
selection.pastespecial paste:=xlvalueEz a 3 sor a C3 cella értékét illeszti be az A5 cellába.
A selection.pastespecial paste:=xlpasteformats a formátumot másolja,
a selection.pastespecial paste:=xlformulas pedig a képletet.cells(1,3).copy cells(5,1) mindent másol.
Szerk.: elkéstem.
-
Mutt
senior tag
válasz
Salex1
#17322
üzenetére
Hello,
Az Excel egyik problémája, hogy az utolsó használt cellát nem olyan könnyú megtalálni.
A http://www.mrexcel.com/td0058.html oldalon van pár megoldás ugyanarra a problémára. A gond szinte mindegyikkel az, hogy ha a szűrő be van kapcsolva, akkor nem megbízhatóak.
Nekem többnyire a DARAB2 vagy DARABTELI függvényes megoldás válik be, mert ez szűrő esetén is korrekt.
Azonban nem használható ha az oszlopban nem összefüggő az adatsor (van benne lyuk).Szóval ezeket tudom javasolni:
NextRow = WorksheetFunction.CountA(Range("B:B")) + 1
NextRow = WorksheetFunction.CountIf(Range("B:B"), "*") + 1
NextRow = Range("B1").End(xlDown).Row + 1üdv.
-
Mutt
senior tag
válasz
Salex1
#16983
üzenetére
Hello,
A második munkalapon van egy név és egy dátum, ha ez a dátum a mainál régebbi, akkor a nevet kellene áttenni az első munkalap következő üres sorába.
2 megoldást is találsz itt.
Az egyik makró mentes, és kimutatást használ.
Nálam Referencia nevű lapon van az adatsor, ebben van a dátum és egy számított mező (a pivot miatt kell) amely megmondja, hogy lejárt-e már a dátum. Az egész egy igazi táblázatban van, amely biztosítja hogy amikor új sort viszel be akkor a számított mező automatikusan létrejön (nem kell neked másolnod) és hogy a pivot az újabb értékeket is megtalálja. Az első munkalapon pedig van egy kimutatás, amely a fájl minden megnyitásakor automatikusan frissül és a számított mező alapján szűr. Ami gond, hogy a kiimutatás sorba rendez, így nem a dátum szerint fogod látni az eredményeket. És csak akkor frissül ha újra megnyitod a fájlt.A másik megoldás pedig egy makró használata, amely a munkalapra váltáskor mindig lefut. Azonban hogy feleslegesen ne vigyen át adatok kell neki egy jelzés azon sorokról amelyeket már átmásolt, ez van a negyedik oszlopban (ez elrejthető ha zavar). Az eredményt a Makroval lapra rakja.
A kód pedig:
Private Sub Worksheet_Activate()
Dim vLastRow As Long
Const vTargetSheet As String = "Makroval" 'a lap neve ahova másolni kell a lejártakat
Const vDatumOszlop As Long = 2 'hanyadik oszlopban van a dátum
Const vFlagOszlop As Long = 4 'jelzés hogy melyik lett másolva már
Dim i As Long
'megnézük a cél helyen az utolsó sort
vLastRow = Application.WorksheetFunction.CountA(Sheets(vTargetSheet).Range("A:A")) + 1
'az aktuális lap sorain végigmegyünk
For i = 2 To Application.WorksheetFunction.CountA(Range("A:A"))
'ahol nincs kitöltve a másolás oszlop és a dátum a múltban van azokat másoljuk
If IsEmpty(Cells(i, vFlagOszlop)) And Cells(i, vDatumOszlop) < Date Then
Range(Cells(i, 1), Cells(i, vDatumOszlop)).Copy Destination:=Sheets(vTargetSheet).Range("A" & vLastRow)
'flaget beállítjuk
Cells(i, vFlagOszlop) = "x"
vLastRow = vLastRow + 1
End If
Next i
End Subüdv.
-
#2038
matekmatika
tag
Salex1
#2037
matekmatika
tag
''Munka1'' és ''Munka2'' munkalapokat feltételezve:
Munka1 A oszlopában nevek, B oszlopában telefonszámok, ekkor
Munka2 A1 cellájába ha beírsz egy nevet (amely szerepel Munka1 A oszlopában) a mellette levő B1 cellába pedig a következő képletet:
=FKERES(A1;Munka1!A;2;HAMIS)
akkor a B1-ben megjelenik a megfelelő telefonszám. Ezt a képletet a cella jobb alsó sarkában levő négyzetet ha lehúzod, tovább tudod másolni az alatta levő cellákba is.
Persze ennél szebb a:
=HA(A1='''';'''';FKERES(A1;Munka1!A;2;HAMIS))
képlet mert itt nincs #HIÁNYZIK felirat abban az esetben ha Munka2 A1 cellája még üres.
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- BESZÁMÍTÁS! ASUS B450 R7 2700X 16GB DDR4 512GB SSD RTX 2060 Super 8GB Zalman i3 FSP 600W
- Xiaomi Redmi Note 10 Pro 128GB, Kártyafüggetlen, 1 Év Garanciával
- ÁRGARANCIA! Épített KomPhone Ryzen 5 5500 16/32/64GB RAM RTX 4060 8GB GAMER PC termékbeszámítással
- ÁRGARANCIA!Épített KomPhone Ryzen 5 5500 16/32/64GB RAM RTX 4060 8GB GAMER PC termékbeszámítással
- Bomba ár! Dell Latitude 7390 2in1 - i7-8G I 16GB I 256SSD I 13,3"FHD Touch I HDMI I Cam I W11 I Gar
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: Promenade Publishing House Kft.
Város: Budapest