-
GAMEPOD.hu
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
Topikgazda
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.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz ny.erno #41801 üzenetére
Táblázattá alakítod a tartományodat (Beszúrás | Táblázat). Elkészíted a kimutatást (Beszúrás | Kimutatás). Ide a szükséges mezőket viszed be. Az adatok bővítésekor a kimutatásban a Frissítésre kattintva a kibővített táblázat adatait láthatod.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
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.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Mutt
aktív 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
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Fferi50
őstag
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.[ Szerkesztve ]
-
Fferi50
őstag
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. -
félisten
válasz ny.erno #46731 üzenetére
Max 10000 sort lehet szűrni ill. az sem mindegy, hogy a szűrt tartomány celláiban milyen típusú adatok szerepelnek. Vélhetően elérted ezt a limitációt.
Bontsd szét az adatokat 2 vagy több munkalapra (ha megoldható) avagy adatbázis kezelőt használj (Access).
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
-
Fferi50
őstag
válasz ny.erno #47836 üzenetére
Szia!
Mivel keresed a duplikációt?
Excelben miért nem használható az Adatok - duplikációk eltávolítása? Az A oszlopot átmásolni a B oszlopba és a B oszlopra lefuttatni a fenti menüpontot.
Libre Office lehetőségeit nem ismerem, esetleg ott is lehet már ilyen funkció.
Üdv.[ Szerkesztve ]
-
Fferi50
őstag
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
őstag
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.[ Szerkesztve ]
-
Fferi50
őstag
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
őstag
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
őstag
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
őstag
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
őstag
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
őstag
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. -
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!
Új hozzászólás Aktív témák
- Azonnali VGA-s kérdések órája
- EA Sports WRC '23
- Azonnali informatikai kérdések órája
- HiFi műszaki szemmel - sztereó hangrendszerek
- gban: Ingyen kellene, de tegnapra
- TCL LCD és LED TV-k
- Genshin Impact (PC, PS4, Android, iOS)
- Linux felhasználók OFF topikja
- Xbox Series X|S
- Motorolaj és szűrő topik
- További aktív témák...
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Windows, Office licencek a legolcsóbban, egyenesen a Microsoft-tól - 2990 Ft-tól!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Bitdefender Total Security 3év/3eszköz! - "Tökéletes védelem most kedvező áron..."
- Warhammer Online - Age of Reckoning (DE) Collectors Box (Figurával!)
Állásajánlatok
Cég: Alpha Laptopszerviz Kft.
Város: Pécs
Cég: Ozeki Kft.
Város: Debrecen