- iPhone topik
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Mobil flották
- Hammer 6 LTE - ne butáskodj!
- Samsung Galaxy Watch6 Classic - tekerd!
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Samsung Galaxy A54 - türelemjáték
- Eltűnhet a Dinamikus Sziget
- Xiaomi 15 - kicsi telefon nagy energiával
- Yettel topik
-
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
-
#48451
Lasersailing
senior tag
ny.erno
#48447
Lasersailing
senior tag
válasz
ny.erno
#48447
üzenetére
Szia,
Én jobb szeretem ilyenkor a vlookup-ot használni (magyarul FKERES) : utólag könnyebb módosítani, meg én legalábbis könyebben átlátom, mint a sok IF/HA függvényt egymásba ágyazva.
Kis értelmező segíség:
A oszlopban vannak az értékeid, amiket növelni kell.
B1 képletét látod a tetején. Másolható lefelé
D oszlop: Ebben keresi pl. A1 értékét
F oszlop: semmire nem kell, csak a szemednek segítség. Excel nem használja, akár el is lehetne hagyni
E oszlop: ezzel növeled A oszlop értékét a B-ben, (megfelelő sorban szereplő értékkel).Az utolsó két sorba tettem olyan példát ami hibát dob:
1: nincs 1 vagy ennél kisebb szám a jobb oldali táblázatban
181: 181+???-et nem tudja értelmezniVLOOKUP / FKERES:
1) mit keressen
2) hol keresse (első oszlopában fogja keresni csak!)
3) hanyadik oszlopot jobbra számolva adja vissza (pl. itt a D az első, E a második, F a harmadik, 4 esetén hibát dobna!)
4) 0 ha csak pontos találat esetén adjon eredményt,
1, ha "pontatlan" találat esetén is adjon eredményt. "Pontatlan" keresés jelentése: Az utolsó olyan sor, amikor a keresett értéknél kisebb a tartomány értékeEz utóbbiból következik, hogy a jobboldali tábla rendezett kell legyen!
-
Fferi50
Topikgazda
válasz
ny.erno
#48093
üzenetére
Szia!
Az Excel valamiért nem ismeri fel automatikusan a kódolást, ezért meg kell "erőszakolni" egy kicsit.
[Itt találhatsz segítséget az átalakításhoz]
Szövegfájlként kell beolvasni és a szövegvarázslóban megkeresni az UTF-8 kódot, nagyon a vége felé lesz.
Üdv. -
-
Fferi50
Topikgazda
válasz
ny.erno
#47869
üzenetére
Szia!
If Sheets.Count = 1 Then
Set sh2 = ActiveWorkbook.Sheets.Add(after:=sh1)
Else
Set sh2 = Sheets(2)
End If
Ez a rész akkor ad hozzá új munkalapot, ha csak egy lap van a munkafüzetben. Ha több, akkor a második munkalapot használja - amin elvileg az első futás után a pivot keletkezik.
Ugye első futás előtt követelmény, hogy csak 1 munkalap legyen a füzetben, így a futáskor létrehozott munkalap lesz a második.
Ismételt futás után már nem kell a pivotot létrehozni, az ott van a második munkalapon, csak aktualizálni kell.If .Value <> "" Then .CurrentRegion.ClearContents
If sh1.Range("D1").Value <> "" Then sh1.Range("D1").CurrentRegion.ClearContents
If sh1.Range("F1").Value <> "" Then sh1.Range("F1").CurrentRegion.ClearContents
Ez a 3 sor törli a második munkalap D1-es területét és az első munkalap D1 és F1 oszlopát.
Szerintem nem lenne szükség törlésre.
Mi miatt volt nálad a külön törlésekre szükség?
Üdv. -
Fferi50
Topikgazda
válasz
ny.erno
#47863
üzenetére
Szia!
Én az egyik futásnál ellenőriztem, hogy megvan-e mind a kétszázezer szám (ismétlődések összeadva + az egyedi) pontosan megvolt.
A pivottáblás makró, feltételek:
Első futtatásnál:
Csak 1 munkalap legyen a munkafüzetben, amelyiknek az A oszlopában ott vannak a számok. A1 cella fejléc.
Ekkor a makró létrehoz egy nevet - forras - a névkezelőben, ami beállítja a pivot forrását
Ezután létrehoz egy új munkalapot, arra a pivottáblát.
Az új D1 cellájától kezdve átmásolja a pivot eredményét.
Szűri 1 -re (azaz egyediek) - átmásolja az első munkalap D oszlopába
Szűri >1-re (azaz ismétlődők) - átmásolja az első munkalap F oszlopába
Ez kb. fél perc 200000 tételnél.
Ha a továbbiakban a változások kezelésére is ezt szeretnéd használni, akkor nincs más teendő, mint az új sorozatszámokat hozzáírni/felülírni az első munkalap A oszlopában, majd jöhet a
második/sokadik futtatás
Fontos! Ebben az esetben is az első munkalapon kell állnod, amikor a makrót indítod.
Az előző futás eredménye felülíródik a D és F oszlopokban.
Íme a makró:Sub tablas()
Dim sh1 As Worksheet, sh2 As Worksheet, pvt As PivotTable, tblsource As String, pvtfname As String, nm As Name
Application.ScreenUpdating = False
Set sh1 = ActiveSheet: pvtfname = sh1.Range("A1").Value
If Names.Count > 0 Then
Set nm = Names("forras")
End If
If nm Is Nothing Then Set nm = ActiveWorkbook.Names.Add(Name:="forras", RefersTo:="=OFFSET(" & sh1.Name & "!$A$1,0,0,COUNTA(" & sh1.Name & "!$A$1:$A$300000),1)")
If Sheets.Count = 1 Then
Set sh2 = ActiveWorkbook.Sheets.Add(after:=sh1)
Else
Set sh2 = Sheets(2)
End If
tblsource = Replace(Evaluate(Names("forras").RefersTo).Address(ReferenceStyle:=xlR1C1, external:=True), "[" & sh2.Parent.Name & "]", "")
If sh2.PivotTables.Count = 0 Then
Set pvt = sh1.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tblsource, Version:=6).CreatePivotTable(tabledestination:=Replace(sh2.Range("A1").Address(ReferenceStyle:=xlR1C1, external:=True), "[" & sh2.Parent.Name & "]", ""), TableName:="Srszamok", Defaultversion:=6)
pvt.AddDataField pvt.PivotFields(pvtfname), "Darabszám", xlCount
pvt.PivotFields(pvtfname).Orientation = xlRowField
Else
Set pvt = sh2.PivotTables(1)
pvt.RefreshTable
End If
With sh2.Range("D1")
If .Value <> "" Then .CurrentRegion.ClearContents
If sh1.Range("D1").Value <> "" Then sh1.Range("D1").CurrentRegion.ClearContents
If sh1.Range("F1").Value <> "" Then sh1.Range("F1").CurrentRegion.ClearContents
.Resize(rowsize:=pvt.TableRange1.Rows.Count, columnsize:=pvt.TableRange1.Columns.Count).Value = pvt.TableRange1.Value
With .CurrentRegion
.AutoFilter field:=2, Criteria1:="1"
.Columns(1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("D1")
.AutoFilter field:=2, Criteria1:=">1"
.Columns(1).SpecialCells(xlCellTypeVisible).Copy Destination:=sh1.Range("F1")
.AutoFilter field:=2
End With
End With
sh1.Range("D1").Value = "Egyedi": sh1.Range("F1").Value = "Ismétlődő"
sh1.Activate
ActiveWindow.ScrollRow = 1
Range("D1").Select
MsgBox "Készen vagyunk!"
Application.ScreenUpdating = True
End Sub
Üdv. -
Fferi50
Topikgazda
válasz
ny.erno
#47856
üzenetére
Szia!
Közben találtam egy makró nélküli megoldást is, de ehhez pár műveletet el kell végezni :
1. Legyen az A oszlopnak fejléce - mondjuk Sorozatszám
2. Beszúrás - kimutatás - új lapra
Sorozatszám mező a Sorokhoz
Sorozatszám mező az Érték területre - mennyiség Sorozatszám
Elfogadható időn belül kész a kimutatás!
3. Az egész kimutatást a végösszeg sor nélkül kijelölni - beillesztés értéket egy új területre az új lapon.
4. Szűrő bekapcsolása az átmásolt adatokra
5. Szűrő - csak az 1 bekapcsolva - az egyedi értékek lesznek. Sorozatszám másolás - irányított beillesztés értéket - oda, ahol látni szeretnéd az egyedi sorozatszámokat
6. Szűrő - átállítás az 1 kivételével minden - az ismétlődő értékek maradnak. Sorozatszám másolás - irányított beillesztés - oda, ahol az ismétlődéseket szeretnéd látni.
Kétszázezer sorral kevesebb ideig tartott, mint ide leírni!
Persze usert ilyenre kérni nem lehet, tesztelem a hozzá kapcsolódó makrót, ha kész lesz felmásolom.
Üdv. -
Fferi50
Topikgazda
válasz
ny.erno
#47856
üzenetére
Szia!
Íme:Sub valogato()
Dim a, x As Long, y As Long, u As String, d, v As String
ActiveSheet.UsedRange.Columns("A").Copy Range("D1")
y = ActiveSheet.UsedRange.Rows.Count
Debug.Print "sort indul:" & Time
With Range("D1:D" & y)
.Sort key1:=Range("D1"), Header:=xlNo
Debug.Print "sort vége:" & Time
a = .Value
End With
u = ""
Debug.Print "Keresés indul: " & Time
d = ""
For x = 1 To y - 1
If a(x, 1) = a(x + 1, 1) Then
If d = "" Then
u = u & ";" & a(x, 1): d = a(x, 1)
Else
If a(x + 1, 1) <> d Then u = u & ";" & a(x, 1): d = a(x, 1)
End If
Else
If a(x, 1) <> d Then v = v & ";" & a(x, 1)
End If
DoEvents
If x Mod 1000 = 0 Then Application.StatusBar = "Készen van eddig " & x
Next
If a(x, 1) <> d Then v = v & ";" & a(x, 1)
Debug.Print "Keresés vége:" & Time
u = Mid(u, 2): v = Mid(v, 2)
a = Application.Transpose(Split(u, ";"))
Range("M1:M" & UBound(a)).Value = a
a = Application.Transpose(Split(v, ";"))
Range("F1:F" & UBound(a)).Value = a
Debug.Print "Visszaírás vége: " & Time
Application.StatusBar = False
MsgBox "Készen vagyunk"
End Sub
Az F oszlopba írja ki az ismétlődés nélküli értékeket.
Üdv. -
Fferi50
Topikgazda
válasz
ny.erno
#47853
üzenetére
Szia!
Azért remélem, hogy az Excel által talált duplikáció az igazi.
Persze ne feledjük, hogy az 123 szöveg és a 123 szám az nem egyforma az Excelben, ebből lehet eltérés.
Gondolom, a sorozatszámaidban betű is van és akkor nem játszik az előző megjegyzésem.
Üdv.
Ps. Remélem, könnyebb lesz az életed vele. -
Fferi50
Topikgazda
válasz
ny.erno
#47843
üzenetére
Szia!
Akkor próbáljuk meg makróval:Sub valogato()
Dim a, x As Long, y As Long, u As String, d
ActiveSheet.UsedRange.Columns("A").Copy Range("D1")
y = ActiveSheet.UsedRange.Rows.Count
Debug.Print "sort indul:" & Time
With Range("D1:D" & y)
.Sort key1:=Range("D1"), Header:=xlNo
Debug.Print "sort vége:" & Time
a = .Value
End With
u = ""
Debug.Print "Keresés indul: " & Time
d = ""
For x = 1 To 200000 - 1
If a(x, 1) = a(x + 1, 1) Then
If d = "" Then
u = u & ";" & a(x, 1): d = a(x, 1)
Else
If a(x + 1, 1) <> d Then u = u & ";" & a(x, 1): d = a(x, 1)
End If
End If
DoEvents
If x Mod 1000 = 0 Then Application.StatusBar = "Készen van eddig " & x
Next
Debug.Print "Keresés vége:" & Time
u = Mid(u, 2)
a = Application.Transpose(Split(u, ";"))
Range("M1:M" & UBound(a)).Value = a
Debug.Print "Visszaírás vége: " & Time
Application.StatusBar = False
MsgBox "Készen vagyunk"
End Sub
A makró az aktív munkalap A oszlopát átmásolja a D oszlopba majd rendezi. Ezután válogatja ki az ismétlődő értékeket és beírja az M oszlopba.
Az előrehaladást a státusz soron lehet követni (ez csak akkor látszik, ha a munkalap nézetben vagy).
A VBA nézet Immediate lapjára kiírja az egyes műveletek végrehajtási idejét. Nekem ez 200000 sor esetén alig több, mint 1 perc volt.
Üdv. -
Fferi50
Topikgazda
válasz
ny.erno
#47841
üzenetére
Szia!
Nem írtad, hogy milyen módszerrel vizsgálod a duplikációt, ami 30-40 percig tart.
Én csak Excel módszert tudok javasolni a 2016-os verzió alapján, feltételezve, hogy az A1 cellától kezdődnek az adataid.
1. a B1 cella képlete:=HA(DARABTELI($A$1:$A$200000;$A1)>1;$A1;"")
2. a B2 cella képlete:=HA(DARABTELI($A$1:$A$200000;$A2)>1;HA(DARABTELI($B$1:$B1;$A2)=1;"";$A2))
Ez a képlet húzható lefelé.
A B oszlopban így azok a számok maradnak, amelyek duplikálva vannak az A oszlopban, mégpedig az első előfordulásnak megfelelő sorban. Köztük "üres" cellák maradnak.
Ha utána a képleteket átalakítod értékké - másolás - irányított beillesztés értéket - akkor már tudsz a B oszloppal "rendezkedni".
Ha nem az első sorban kezdődnek az adataid, akkor annak megfelelően módosítsd a kezdő képlet celláit - figyelj a $ jelekre kérlek.
Üdv. -
Fferi50
Topikgazda
-
#46734
Fire/SOUL/CD
félisten
ny.erno
#46731
-
Fferi50
Topikgazda
válasz
ny.erno
#46139
üzenetére
Szia!
Nézd meg légy szíves, hogy a képletekben (beleértve a feltételes formázást is) vannak-e egész sorra-oszlopra vonatkozóak.
Azokat váltsd át konkrét tartományokra, akkorákra, amekkora feltételezhetően elegendő.
(Képzeld el, ha egymillió sort kell szűrni, az azért időbe telik.)
Üdv. -
Fferi50
Topikgazda
válasz
ny.erno
#46099
üzenetére
Szia!
1. Ehhez kellenének egyértelmű megfeleltethetőségek a két munkalap között. Jelenleg pl. a handyshop.cc -hez 15 e-mail cím tartozik. Honnan fogod tudni, melyiket kell átvinni hozzá?
2. Az Excel fájlból lehet lekérdezést készíteni, de ehhez arra van szükség, hogy tudd, melyik fejlécnek melyik fejléc felel meg a két fájlban. Más szóval, melyik oszlop tartalmazza a Munkafüzet1-ben azokat az adatokat, amelyeket a Main_database fájl Cégnév oszlopába szeretnél beolvasni és így tovább.
A lekérdezést utána át lehet alakítani értékké a kapcsolat megszüntetésével. Ezután már törölhető a "munka" fájlod.
Üdv.
Ps. (Nem) mellesleg adatbázist miért Excelben építesz és nem adatbázis kezelőben (pl. Accesben). Sokkal egyszerűbb és kevesebb hibával jár, továbbá oda is "be lehet húzni" az Excelben meglevő adataidat. Persze a megfeleltetések ott is szükségesek. -
Mutt
senior tag
válasz
ny.erno
#43238
üzenetére
Szia,
Azt szeretném elérni, hogy ha megadom a Termékeket, akkor automatikusan jelenjenek meg az adatok a termék nevével azonos munkalapokon.
Feltöltöttem egy új fájlba 3 különböző makrómentes megoldást.
Mindegyik esetben a lapon a H1-es cellába a lap nevét kézzel be kell írni.
1. Tömbfüggvény
Hátránya, hogy sok adat esetén be fogja lassítani a gépet.
2. Új csak Office365-ben elérhető FILTER függvény
Hátránya, hogy csak a legújabb Excellel használható.
3. Power Query
Excel 2010-től működik, de nem realtime.üdv
-
Delila_1
veterán
válasz
ny.erno
#43238
üzenetére
Külön oszlopokba írd a termékeket. A megfelelő cellákba elég egy betűt írnod. Ha nem volt még a termékednek lapja, a makró létrehozza. Beírja az adatokat a megfelelő helyekre.
A makrót az Adatbazis laphoz kell rendelned.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lapnev, usor As Long, LN As String, uoszlop As Integer
uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
If Target.Column > 2 And Target.Column < uoszlop And Target.Row > 1 And Target.Count = 1 Then
Application.EnableEvents = False
On Error Resume Next
LN = Cells(1, Target.Column)
Set lapnev = Sheets(LN)
If Err.Number <> 0 Then
Sheets.Add.Name = LN
Sheets(LN).Move After:=Sheets.Count + 1
On Error GoTo 0
End If
With Sheets(LN)
.Cells(1) = "Név": .Cells(2) = "Email"
.Cells(3) = "Termék": .Cells(4) = "Kapcsolati forrás"
usor = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Cells(usor, 1) = Cells(Target.Row, "A")
.Cells(usor, 2) = Cells(Target.Row, "B")
.Cells(usor, 3) = LN
.Cells(usor, 4) = Cells(Target.Row, uoszlop)
End With
Sheets("Adatbazis").Move Before:=Sheets(1)
Application.EnableEvents = True
End If
End SubSzerk.: a termékek számát bővítheted, vagy szűkítheted.
-
-
Delila_1
veterán
válasz
ny.erno
#36462
üzenetére
A C2-be írd be a lenti képletet, amiben a saját keresett kifejezéseidet adod meg.
=HAHIBA(SZÖVEG.KERES("zöldség";B2);0)+HAHIBA(SZÖVEG.KERES("fehérje";B2);0)+HAHIBA(SZÖVEG.KERES("gabona";B2);0)+HAHIBA(SZÖVEG.KERES("termesztés";B2);0)+HAHIBA(SZÖVEG.KERES("szántóföld";B2);0)Az eredmény egy szám lesz. Azokban a sorokban, ahol egyik kifejezés sem található meg, ez a szám nulla lesz. Szűrhetsz a C oszlop alapján.
Gondolom, legalább 2007-es verziót használsz, bár a fájl kiterjesztése xls. A "Szövegből oszlopok" menüpont az előző, 2003-as verzióban még nem állt rendelkezésre, mint ahogy a HAHIBA függvény sem.
sajnos.
Új hozzászólás Aktív témák
Hirdetés
Fferi50- Szeged és környéke adok-veszek-beszélgetek
- A látszat ellenére helyesen működik az NVIDIA-féle Resizable BAR implementáció
- iPhone topik
- Kerékpárosok, bringások ide!
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Milyen billentyűzetet vegyek?
- Mobil flották
- Path of Exile (ARPG)
- OTP Bank topic
- Bambu Lab 3D nyomtatók
- További aktív témák...
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Vírusirtó, Antivirus, VPN kulcsok
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Álmodozol egy erősebb gamer élményről? Kamatmentes rèszletre is!
- BESZÁMÍTÁS! MSI X470 R7 5800X 32GB DDR4 512GB SSD ROG STRIX RTX 2080 Super 8GB Rampage SHIVA 650W
- Olcsó Laptop! Dell Latitude 7280. I5 7300U / 8GB DDR4 / 256GB SSD
- Lenovo V130-15IGM laptop (Pentium Silver N5000/8GB/256GB SSD
- Napi 700 ft tól elvihető RÉSZLETRE BANKMENTES HP 840 G11 Ultra 5
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Promenade Publishing House Kft.
Város: Budapest