- Mobil flották
- Huawei Watch GT 2 Pro - egyszerűen gyönyörű
- Samsung Galaxy Watch6 Classic - tekerd!
- Xiaomi 15 - kicsi telefon nagy energiával
- Itthon is kapható lesz a kerámia Xiaomi Band 10
- Magisk
- Csak semmi szimmetria: flegma dizájnnal készül a Nothing Phone (3)
- iPhone 16e - ellenvetésem lenne
- Milyen okostelefont vegyek?
- Garmin Forerunner 970 - fogd a pénzt, és fuss!
-
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
-
#23600
m.zmrzlina
senior tag
Hyper84
#23599
m.zmrzlina
senior tag
válasz
Hyper84
#23599
üzenetére
A "torolni " munkalap A oszlopába nem a s01... stb-t írod hanem az A01.... stb-t és a
If Application.WorksheetFunction.CountIf(rngTorolni, rngCella) = 1 helyett
If Application.WorksheetFunction.CountIf(rngTorolni, rngCella) = 0 lesz
A többi ugyanaz.
Azt gondolom mondani sem kell, hogy legyen a fáljból biztonsági másolatod. -
#23598
m.zmrzlina
senior tag
m.zmrzlina
#23597
m.zmrzlina
senior tag
válasz
m.zmrzlina
#23597
üzenetére
Ehhez a módszerhez mindenképp kell egy tartomány amiben a "halálra ítélt" azonosítók vannak.
Meg lehet fordítva is csinálni de akkor a maradó azonosítók listája kell és a Countif() nulla értékénél kell törölni.
Ugyanaz csak pepitában.
-
#23593
m.zmrzlina
senior tag
Hyper84
#23592
m.zmrzlina
senior tag
válasz
Hyper84
#23592
üzenetére
1. Létrehoztam egy munkalapot a "torolni" néven
2. Ennek a munkalapnak az A oszlopába felvittem azokat az elemeket amelyeknek az oszlopát törölni kell
3. A munkalap amin a törlendő adatok vannak "adatok " nevet kapott
4. A For Each sor végén lévő Range("A1:Z1") azt a tartományt jelöli ameddig a te adataid tartanak az "adatok" munkalapon.Sub oszlop_torol()
Dim rngTorolni As Range
Dim rngCella As Range
Dim wsAdatok As Worksheet
Set wsAdatok = ThisWorkbook.Worksheets("adatok")
Set rngTorolni = ThisWorkbook.Worksheets("torolni").Range("A:A")
For Each rngCella In wsAdatok.Range("A1:Z1")
If Application.WorksheetFunction.CountIf(rngTorolni, rngCella) = 1 Then
rngCella.EntireColumn.Delete
End If
Next
End Sub -
#23591
m.zmrzlina
senior tag
Hyper84
#23590
m.zmrzlina
senior tag
válasz
Hyper84
#23590
üzenetére
Én eltárolnám egy oszlopba azokat a fejlécelemeket amelyek oszlopát tötölni kell majd egy for each next-tel és egy =CountIf()-fel végigmennék a fejlécen. Ahol a =CountIf() 1-et ad vissza ott törölném az egész sort.
Ha teszel be egy képet a munkalapodról (vagy legalább leírod, hogy hogyan néz ki) konkrétabb is tudok lenni.
-
#23575
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Így próbálok feltölteni adattal két tömböt:
arrAnalist() = wsKabelo.Range("A2:A" & intListahossz)
arrDigilist() = wsKabelo.Range(Cells(2, intDigitlista_oszlop), Cells(intListahossz, intDigitlista_oszlop))Ha nem az a munkalap aktív amelyikről az adatokat a tömbbe kell írni akkor a második sornál a "worksheet objektum range metódusa hibás" hibaüzenetet kapom. Az első sor gond nélkül lefut.
Ha a két sor elé beteszem, hogy:
wsKabelo.Select
akkor mind a két sor hiba nélkül megy.Mi lehet az oka?
-
#23569
m.zmrzlina
senior tag
Carasc0
#23567
m.zmrzlina
senior tag
-
#23559
m.zmrzlina
senior tag
Mittu88
#23558
m.zmrzlina
senior tag
válasz
Mittu88
#23558
üzenetére
Az volt a probléma, hogy volt egy kezdőérték, lefutott a teljes kód aminek során megváltozott és ennek a kódnak egy részét szeretném újra futtatni.
Namármost: a kezdeti értéket nem adhatom meg a részkód futtatásánál mert ha már egyszer lefutott a teljes kód akkor már nem megyek semmire azzal az értékkel. Ha viszont itt adok értéket neki akkor meg a teljes kód futtatásánál kavar be.
De mindegy is Fferi50 tippje alapján fogok boldogulni a problémával.
Köszi mindenkinek aki segített.
-
#23550
m.zmrzlina
senior tag
sedyke
#23547
m.zmrzlina
senior tag
válasz
sedyke
#23547
üzenetére
A tiédhez nagyon hasonló probléma volt itt.
-
#23546
m.zmrzlina
senior tag
Fferi50
#23545
m.zmrzlina
senior tag
válasz
Fferi50
#23545
üzenetére
Jól gondolom, hogy ha a munkalapra kiírós megoldást választom akkor az objektumváltozókat sem kell Public-ként deklarálni csak minden eljárás elején (persze csak ami használja ) értékadással kell kezdeni? Pl:
Dim wsOsszesito as Worksheet
.
.
Sub makro1()
Set wsOsszesito = ThisWorkbook.Worksheets("összesítő")
.....
End Sub -
#23544
m.zmrzlina
senior tag
Polllen
#23543
m.zmrzlina
senior tag
-
#23542
m.zmrzlina
senior tag
m.zmrzlina
senior tag
A következő kérdésem lenne:
Van egy munkafüzetem abban van egy makró ami 4-5 jól ekülöníthető dolgot csinál. Elindítom a makrót szépen lineárisan elejétől a végéig lefut megteszi a dolgát, mindenki örül.
Néha azonban szükség van arra, hogy a teljes makrónak egyes részeit többször, külön is le lehessen futtatni (pl hogy két tartomány egyezőségét leelenőrizze) illetve vannak részek amiket kifejezetten nem szeretnék mindig lefuttatni többször (pl a forrás munkalapok más munkafüzetekből való importálására csak egyszer van szükség)
Az a tervem, hogy a teljes kódot egyetlen modulon belül kisebb eljárásokra szabdalom szét és ezekhez az eljárásokhoz külön parancsikonokat teszek a gyorsindítás eszköztárra.
Itt kezdődik a probléma mivel az egyes eljárások jórészt ugyanazokat a változókat használják.
Milyen tipusú változók kellenek és hogyan kell ezeket az eljárások között adni-venni?
Tudom, ez a téma sokkal bővebb mintsem egy válaszban minden részét ki lehetne vesézni, de nekem már az is sokat segít, ha valaki "irányba állít" és 600 oldal manual helyett csak pl 50-et kell elolvasnom.
-
#23524
m.zmrzlina
senior tag
kutga
#23519
m.zmrzlina
senior tag
Szerintem ez a feladat egyszerűen megoldható (feltéve, ha jól értem a problémát).
Tegyük fel, hogy nagyjából úgy néz ki a munkafüzeted ahogy kettővel lejjebb Wyll lerajzolta
Csinálsz egy munkalapot ebbe a munkafüzetbe, legyen a neve mondjuk "összesítő"Erre a munkalapra kialakítod a számodra legmegfelelőbb szerkezetet és a megfelelő helyekre behivatkozod azokat a cellákat aminek a tartalmát látni szeretnéd.
A képen most a cellák képleteit látod de ha beírod a képletetet akkor a hivatkozott cella tartalmát fogod látni.
-
#23504
m.zmrzlina
senior tag
Delila_1
#23502
m.zmrzlina
senior tag
-
#23501
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Adott 2 munkalap. Mindkettőn azonos számú sorból de változó számú oszlopból álló tartományok. Egy harmadik munkalapra össze szeretném másolni ezeket egymás mellé (azonos a sorok száma ugyebár)
Így próbálom:
1. az első munkalapot lemásolom és "összesítő" néven hozzáadom a munkafüzethez
2.meghatározom az első üres oszlop számát és változóba írom (erre a változóra később még szükség lesz)
elsoures_oszlop = wsOsszesito.Range("A1").CurrentRegion.Columns.Count + 1
3. Másolok(nék)
wsTemp.Range("A1").CurrentRegion.Copy Destination:=wsOsszesito.[B]???????[/B]C][/M]
Hogyan jelölöm ki a legegyszerűbben a célterületet? -
#23488
m.zmrzlina
senior tag
bteebi
#23487
m.zmrzlina
senior tag
válasz
bteebi
#23487
üzenetére
Négy irány:
Sub fornext_bjfl() 'balról jobbra fentről le
For i = 1 To 10
For j = 1 To 5
Cells(i, j).Select
Next
Next
End Sub
Sub fornext_jblf() 'jobbról balra lentről fel
For i = 10 To 1 Step -1
For j = 5 To 1 Step -1
Cells(i, j).Select
Next
Next
End Sub
Sub fornext_jbfl_() 'jobbról balra fentről le
For i = 1 To 10
For j = 5 To 1 Step -1
Cells(i, j).Select
Next
Next
End Sub
Sub fornext_bjlf() 'balról jobbra lentről fel
For i = 10 To 1 Step -1
For j = 1 To 5
Cells(i, j).Select
Next
Next
End SubRemélem nem írtam el.
-
#23486
m.zmrzlina
senior tag
bteebi
#23485
-
#23480
m.zmrzlina
senior tag
-PLevi-
#23477
m.zmrzlina
senior tag
válasz
-PLevi-
#23477
üzenetére
Egy kicsit kecsesebb ez a megoldás de a lényeg ugyanaz mint az előbbinél.
Sub atszamoz()
holavege = Range("A" & Rows.Count).End(xlUp).Row
Cells(1, 1).Select
i = 1
Do While Not ActiveCell.Row > holavege
If ActiveCell.EntireRow.Hidden = False Then
ActiveCell.Value = i
i = i + 1
Else
ActiveCell = Empty
End If
ActiveCell.Offset(1, 0).Select
Loop
End SubEz nem kíván folyamatos tartományt az A oszlopban és nem ír semmit a rejtett sorokba.
-
#23479
m.zmrzlina
senior tag
-PLevi-
#23477
m.zmrzlina
senior tag
válasz
-PLevi-
#23477
üzenetére
Azt nem tudom, hogy makró nélkül megoldható-e de itt egy példa egy makrós megoldásra:
Sub atszamoz()
Cells(1, 1).Select
i = 1
Do While ActiveCell.Value <> ""
If ActiveCell.EntireRow.Hidden = False Then
ActiveCell.Value = i
i = i + 1
Else
ActiveCell.Value = 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End SubA tartomány kijelölése másképp is megoldható mint itt. A lényeg: végigmész az egész tartományon leellenőrzöd, hogy rejtett-e az aktuális sor és ha nem rejtett adsz neki egy sorszámot. Ezt a makrót minden új szűrés után le kell futtatni.
-
#23442
m.zmrzlina
senior tag
lappy
#23430
m.zmrzlina
senior tag
Két kérdés:
A munkalapon közös keretben lévő cellák egyesítve vannak vagy külön cellák csak a keretük közös? (gyanítom külön cellák) Ha van köztük egyesített, melyek azok?
A különböző napokhoz tartozó űrlap részletek nyilván nem véletlenül különböznek. Van rá lehetőség, hogy egységes fejlécet kapjanak?
-
#23433
m.zmrzlina
senior tag
Mittu88
#23432
m.zmrzlina
senior tag
válasz
Mittu88
#23432
üzenetére
Kijelölt cella értékének változóba írása:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$I$6" Then 'ide jön, hogy melyik celláról van szó
ertek1 = Target.Value
End If
End SubMódosított cellaérték változóba írása:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$6" Then 'ide jön, hogy melyik celláról van szó
ertek2 = Target.Value
End If
End Sub -
#23429
m.zmrzlina
senior tag
.OM.
#23423
m.zmrzlina
senior tag
Próbáld ki ezt! Szerintem közel van ahhoz amit szeretnél. Úgy indítasz, hogy kijelölöd azt a tartományt aminek a szineit másolni szeretnéd és elindítod a makrót.
Sub masol()
Dim intSorok As Integer
Dim intOszlopok As Integer
Dim arrCopyColor()
intSorok = Selection.Rows.Count
intOszlopok = Selection.Columns.Count
ReDim arrCopyColor(intSorok, intOszlopok)
For i = 0 To intSorok
For j = 0 To intOszlopok
arrCopyColor(i, j) = Cells(ActiveCell.Row + i, ActiveCell.Column + j).DisplayFormat.Interior.Color
Next
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "colors"
For i = 1 To intSorok
For j = 1 To intOszlopok
Cells(i, j).Interior.Color = arrCopyColor(i, j)
Next
Next
End Sub -
#23425
m.zmrzlina
senior tag
.OM.
#23423
m.zmrzlina
senior tag
Ugye a legprofibb megoldás gondolom az lenne, hogy egy változóba kiírkálni a cellák DisplayFormat.Interior.Color tulajdonságát majd egy újonnan létrehozott munkalapon visszaírni.
Vagy a másik, hogy ha van elég hely a munkalapodon akkor annyi oszloppal jobbra (vagy sorral lejjebb) másolni a formátumot ahol már nem zavar aztán Ctrl+C > formátum másolása az új munkalapra.
Nyilván te is észrevetted, hogy annyit sántít a megoldás, hogy a nofill (nincs kitöltés) hátterű cellákból fehér (colorindex 2) hátterű cellák lesznek. Nem tudom ez mennyire baj.
-
#23422
m.zmrzlina
senior tag
Excelbarat
#23421
m.zmrzlina
senior tag
válasz
Excelbarat
#23421
üzenetére
Ezzel a megoldással csak egy probléma van. Az eredeti kérdés az volt, hogy hogyan lehet feltételesen formázott cellák háttérszíneit lemásolni. Arra pedig ez a kód nem jó.
Amúg szép, ha megengeded használni fogom.
Ha már szinek:
Két rendszergazda beszélget:
-Na milyen az új barátnőd?
-Ne is kérdezd tökéletes. Csúcs ahogy kinéz. 90-60-90
-Nebasz!!! Sötétlila???? -
#23418
m.zmrzlina
senior tag
.OM.
#23414
m.zmrzlina
senior tag
Nekem ezzel a kóddal sikerült lemásolnom (Excel 2010 alatt) egy korábbi munkalapon a feltételes formázás színeit:
Sub masol()
For Each cella In Selection.Cells
cella.Offset(0, 10).Interior.Color = cella.DisplayFormat.Interior.Color
Next
End SubEz a kód a kijelölt tartomány minden cellájának (feltételesen és nem feltételesen formázott) színét 10 oszloppal jobbra másolja.
Ja innen loptam, kipróbáltam és működött. (jsmith4892002 2012 aug 19.-i hozzászólása)
-
#23412
m.zmrzlina
senior tag
Wyll
#23406
m.zmrzlina
senior tag
Vagy nézd meg ezt:
Sub vaneilyen()
Dim File As String
File = InputBox("Add meg a keresett fájl nevét! (kiterjesztéssel együtt)")
Dim DirFile As String
DirFile = ThisWorkbook.Path & "\" & File
If Dir(DirFile) = "" Then
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=DirFile
'vagy
'Workbooks.Open Filename:=másikfájl
'kitölteni a megfelelő adatokkal
'és menteni a kívánt néven
Else
Workbooks.Open Filename:=DirFile
End If
End SubEz a kód ebben a formájában abban a mappában keres amiben a kódot tartalmazó munkafüzet van.
-
#23395
m.zmrzlina
senior tag
slashing
#23393
m.zmrzlina
senior tag
válasz
slashing
#23393
üzenetére
Én ezt egyszer úgy oldottam meg, hogy az inputboxban megadtam a formáját a neveknek amit elfogad a makró.
technikus = UCase(InputBox("Add meg a technikus nevét!" & Chr(10) "TUDOR VIDOR SZENDE SZUNDI MORGÓ HAPCI KUKA MIND"))
If technikus <> "MIND" Then
If Application.WorksheetFunction.CountIf(Worksheets("PrnWinExcel").range("B:B"), technikus) = 0 Then
MsgBox "Nincs ilyen technikus."
Exit Sub
ElseIf technikus = "" Then
Exit Sub
End If
End IfPersze ez csak akkor működik ha minden elfogadható input ismert a programozás idején, nem bővül vagy egészül ki esetleges elemekkel a Worksheets("PrnWinExcel").range("B:B") tartomány vagy van lehetőség a folyamatos frissítésére.
-
#23388
m.zmrzlina
senior tag
m.zmrzlina
#23387
m.zmrzlina
senior tag
válasz
m.zmrzlina
#23387
üzenetére
Talán egy fokkal jobb, ha kiírod tömbbe. Onnantól fogva van egy változód amit kedved szerint módosíthatsz aztán a végén visszaírod a munkalapra.
-
#23387
m.zmrzlina
senior tag
slashing
#23381
m.zmrzlina
senior tag
-
#23376
m.zmrzlina
senior tag
Imy
#23373
m.zmrzlina
senior tag
-
#23366
m.zmrzlina
senior tag
slashing
#23365
-
#23364
m.zmrzlina
senior tag
slashing
#23360
m.zmrzlina
senior tag
válasz
slashing
#23360
üzenetére
Nekem ezt sikerült kiötleni:
Sub makro_1()
elsouzenet = InputBox("blablabla1")
masodikuzenet = InputBox("blablabla2")
datum = InputBox("datum")
Range("D5").Select
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
hanysor = Selection.Rows.Count
hanyoszlop = Selection.Columns.Count
For i = hanyoszlop To 1 Step -1
Range(Cells(1, i), Cells(hanysor, i)).Select
Selection.Insert Shift:=xlToRight
Selection.Value = elsouzenet
Next
Range("A:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Value = masodikuzenet
Range("A1").Value = datum
Range(Cells(1, 1), Cells(hanysor, ActiveCell.End(xlToRight).Column)).Select
Selection.Copy
End Sub -
#23335
m.zmrzlina
senior tag
Mittu88
#23330
-
#23317
m.zmrzlina
senior tag
Mittu88
#23314
m.zmrzlina
senior tag
válasz
Mittu88
#23314
üzenetére
Nekem azt sikerült kiötleni (na jó innen loptam :-) hogy hozzáadsz a munkafüzetedhez egy lapot amin csak egy információ van a felhasználónak, hogy "Nincs engedélyezve a makró. Zárd be a munkafüzetet és nyisd meg újra miután engedélyezted a makrókat!". A fálj bezárásakor ezen a lapon kívül minden munkalapot elrejtesz és mentesz. Ha valaki engedélyezett makróval vagy letiltott makróval de biztonságos helyről nyitja meg a fájlt akkor a Worbook.Open esemény során az összes munkalap rejtése megszűnik csak az üzenetet tartalmazóé marad meg ergó tud dolgozni a user. Ha viszont nincsen engedélyezve a makró akkor megnyílik a fájl de csak egy lap látható amin az üzenet van (hiszen úgy mentetted el a fájlt hogy az összes többi rejtett).
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
For Each sh In Worksheets
sh.Visible = xlSheetVisible
Next
For Each sh In Worksheets
If sh.Name <> "figyelem" Then sh.Visible = xlSheetVeryHidden
Next
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
Dim sh As Worksheet
For Each sh In Worksheets
sh.Visible = xlSheetVisible
Next
For Each sh In Worksheets
If sh.Name <> "figyelem" Then
sh.Visible = xlSheetVisible
Else
sh.Visible = xlSheetVeryHidden
End If
Next
End SubJa és nem Insert>New>Module-ba másolod a makrót hanem a Thisworkbook>Worksheet-ba
-
#23311
m.zmrzlina
senior tag
littleNorbi
#23309
m.zmrzlina
senior tag
válasz
littleNorbi
#23309
üzenetére
Én úgy írnám a fv-t, hogy pl: =FKERES(D2;A:B;2;0) ahelyett, hogy =FKERES(D2;A1:B400;2;0).
Persze csak ha nem zavar be 400. sor után lévő tartomány, (ha van ott egyáltalán valami)
-
#23295
m.zmrzlina
senior tag
gbela
#23294
m.zmrzlina
senior tag
Én ezt csak úgy tudom elképzelni, hogy korábban a két fájl két külön alkalmazásablakban volt megnyitva most meg egyben.
Magyarul egyetlen példányban van az excel megnyitva és azon belül a két fájl. Ha így van akkor nem szabad azt várni, hogy az aktív munkafüzet státuszsorában a nem atívhoz tartozó adatok látszódjanak.
-
#23283
m.zmrzlina
senior tag
bteebi
#23281
m.zmrzlina
senior tag
válasz
bteebi
#23281
üzenetére
A Cells.Replace What:="alma", Replacement:="körte", LookAt:=xlPart, _
SearchOrder:=xlByRows
helyesen: ws.Cells.Replace What:="alma", Replacement:="körte", LookAt:=xlPart, _
SearchOrder:=xlByRowsVagy kevésbé elegánsan: a
For Each ws In ActiveWorkbook.Worksheets
sor után ted be a következő sort:
ws.Activate -
#23245
m.zmrzlina
senior tag
Des1gnR
#23244
m.zmrzlina
senior tag
válasz
Des1gnR
#23244
üzenetére
Csak az elv:
Sub lista_frisit()
Range("B1").Select
Do While ActiveCell.Value <> ""
If Application.WorksheetFunction.CountIf(Range("A:A"), ActiveCell) = 0 Then
Range("A" & (Range("A" & Rows.Count).End(xlUp).Row) + 1) = ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Loop
End SubNálam A1 ben kezdődik a szűkebb B1-ben a bővebb lista.
Természetesen a saját munkalapodra kell faragnod. Ha teszel be képet róla tudjuk pontosítani. -
#23236
m.zmrzlina
senior tag
Des1gnR
#23235
m.zmrzlina
senior tag
válasz
Des1gnR
#23235
üzenetére
Na jó de azzal, hogy kijelölöd azzal még semmit nem oldottál meg. Ennek a cellának az értékét át kellene adni a lastRow változónak. Pl: lastRow = Range("K11").Value.
Én mondjuk nem a Selection.Find-dal csinálnám ezt, hanem az Application.Worksheetfunction.Countif-fel. Magyarul a Darabteli() fv makrós megfelelőjével. Végigmennék az új lista cikkszámain (aminek részhalmaza a régi cikkszám lista - gondolom) és az új listának azt az elemét amin a CountIf nullát ad vissza azt hozzáadnám a régi listához
-
#23233
m.zmrzlina
senior tag
Des1gnR
#23231
m.zmrzlina
senior tag
válasz
Des1gnR
#23231
üzenetére
Szerintem az If Err.Number = 91 Then sornál kellene keresgélni.
Tedd be a sor elé ezt: Debug.Print Err.Number és léptesd a makrót F8-cal és figyeld mit ír az Immediate ablakban a második körben.
Illetve még egy kérdés. Miért kell az új tétel beírása után a K11-be lépni?
-
#23212
m.zmrzlina
senior tag
billyjoe
#23211
-
#20936
m.zmrzlina
senior tag
m.zmrzlina
#20935
m.zmrzlina
senior tag
válasz
m.zmrzlina
#20935
üzenetére
A feladatot egyébként úgy tudnám leírni, hogy ábrázolni kell egyetlen ábrán hogy pl különböző lámpák mettől meddig vannak felkapcsolt és meddig lekapcsolt állapotban a nap folyamán.
Ha más ötlet van azt is szivesen fogadom.
-
#20935
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Powerpointban küzdök vonaldiagrammal de gondolom a beállítások Excelben sem nagyon mások.
Vízszintes tengelyen idő van ábrázolva (24 óra) 15 perces felbontásban. A függőleges tengelyen egytől x-ig egész számok. Minden grafikon két értéket vehet fel a nullát és a grafikon sorszámát. Tehát az első grafikon 0-1 értékekből áll a második 0-2 az x-edik 0-x-ből)
Kérdés: hogyan állítsam be a grafikont, hogy minden vonal csak a 0-tól eltérő értékeket ábrázolja, magyarul ott ahol az érték nulla ott ne látsszon a grafikon vonala.
Valami olyasmire lenne szükségem mint az árfolyamdiagram csak megfordított tengelyekkel, azaz vízszintes vonalakkal.
-
#20004
m.zmrzlina
senior tag
m.zmrzlina
#20002
m.zmrzlina
senior tag
válasz
m.zmrzlina
#20002
üzenetére
Bocsánat, itt a magyarázat egy kissé zavaros. Valójában nem az F oszlopon megy végig, hanem azon az oszlopon aminek az egyik celláját kijelölöd.
-
#20002
m.zmrzlina
senior tag
Wollie
#19998
m.zmrzlina
senior tag
válasz
Wollie
#19998
üzenetére
Próbáld meg a következőt. Az F oszlopban lévő szövegeken megy végig, az E oszlopba kigyűjti az egyedi rekordokat és a D1 cellába kiírja hogy hány különböző rekordot talált. Természetesen a tartományok átírhatók.
Sub lista()
Dim intHanyfele As Integer
Do While ActiveCell.Value <> ""
If Application.WorksheetFunction.CountIf(Range("E:E"), ActiveCell.Value) = 0 Then
Cells(intHanyfele + 1, 5).Value = ActiveCell.Value
intHanyfele = intHanyfele + 1
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("D1").Value = intHanyfele
End SubKicsit ágyúval verébre módszernek tűnik mert meg lehet oldani irányított szűréssel is. Más helyre másolja és Csak egyedi rekordok megjelenítése opciók bekattintva, majd az egyedi rekordokat darabtelivel megszámolni.
-
#20000
m.zmrzlina
senior tag
Latis
#19997
-
#19621
m.zmrzlina
senior tag
geza844
#19616
m.zmrzlina
senior tag
válasz
geza844
#19616
üzenetére
Nem tudom hány cellát érint és mennyire szoktad a "inkognito" cellákat másolgatni ide-oda de jó esetben az is lehet megoldás, hogy nyomtatás előtt ezeket a cellákat eltünteted:
Sub formatum_inkognito()
Range("A1").Select
Selection.NumberFormat = ";;;"
End SubAzután ha megint akarod látni a cellákat akkor vissza lehet állítani a formátumukat az eredetire. Ki lehet tenni egy parancsgombot a makróhoz és nyomtatás előtt csak egy kattintás még akkor is ha sok cellát érint a művelet.
-
#19471
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Játszom egy kicsit.
Van egy képem elszabdalva 90 darabra. A darabokat beillesztettem egy munkalapra egy 3x30 cellás tartományba mindegyiket egy-egy cellához igazítva hogy éppen lefedje a cellát. (a 90 darabka kiadja az eredeti képet mintha puzzle volna) A cellákban a képek "mögött" van adat.
Egy makróval egyenként fel szeretném fedni a képdarabkákat, hogy a cella tartalma alatta láthatóvá váljon. Ezt a következő pár sorral csinálom (gyakorlatilag 90 fokkal elfordítom a képet):
Sub kep_rejt()
For j = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes.Range(Array(j)).Select
For i = 0 To 90
Selection.ShapeRange.ThreeD.RotationX = i
Application.Wait Now + TimeValue("00:00:01") / 10
Next
Next
End SubA belső ciklus és a késleltetés azért kell, hogy ne egyszerre hanem egymás után (mintegy animálva)történjen a kisképek elfordítása. Kicsit olyan hatása van a dolognak mintha a kicsi képek szélessége addig csökkenne amíg el nem tűnnek.
A problémám az, hogy a művelet szépen elindul majd kb a 20. kép táján elakad. Semmi látható nem történik majd pár másodberc múlva egyszerre felfedi az összes maradék képet.
Bármilyen ötletet szivesen fogadok.
-
#19453
m.zmrzlina
senior tag
slashing
#19441
m.zmrzlina
senior tag
válasz
slashing
#19441
üzenetére
Az igazat megvallva az Excel lapvédelem nem egy Enigma bonyolultságú védelem
Kb 5 perc alatt feloldható és ebben már benne van az az idő amíg a pc bebootol plusz amíg kiguglizod a megoldást.
Ez utóbbit megspóroltam neked, mindjárt az első (nem szponzorált) találat. Így már csak 3 perc.
-
#18985
m.zmrzlina
senior tag
hallgat
#18983
m.zmrzlina
senior tag
válasz
hallgat
#18983
üzenetére
A két egymásba ágyazott ciklusban kb 95000 olvasás-írás van. ((1400/3)*190) ez rengeteg időt visz el. Nem a belső ciklusban lévő kiértékelés a sok hanem a feladat végrehajtása a 95000-szeri olvasás-írás. Ezen már csak apró szépségtapasz az egy felesleges sor kihagyása és az Application.ScreenUpdating=False(True) bár néha ez is tud látványos eredményt hozni.
Esetleg a For-Each-Next használata a For-Next helyett segíthet valamit.
A tömböket... No igen, egyszer rá kéne már szánni magam.
Van az a feladat amikor nem tudod megkerülni. -
#18981
m.zmrzlina
senior tag
hallgat
#18980
m.zmrzlina
senior tag
válasz
hallgat
#18980
üzenetére
Nézd át ezt az oldalt! Főleg attól a résztől, hogy: Read/Write Large Blocks of Cells in a Single Operation
Esetleg ez is segíthet. Vagy ez.
Szerintem nem fogod megúszni a tömbök használatát.
-
#18975
m.zmrzlina
senior tag
nova001
#18973
m.zmrzlina
senior tag
-
#18974
m.zmrzlina
senior tag
nova001
#18973
m.zmrzlina
senior tag
válasz
nova001
#18973
üzenetére
Nekem is volt egy hasonló problémám. Az erre adott válaszok közt nézz körül!
Kell hozzá egy ActiveX Combobox. Nálam az egyszerűsíti a dolgokat, hogy egy jól körülhatárolható tartományba (B oszlop) írja egymás alá a Comboboxban (Automatikus kiegészítéssel) bevitt értékeket.
-
#18925
m.zmrzlina
senior tag
Delila_1
#18924
m.zmrzlina
senior tag
válasz
Delila_1
#18924
üzenetére
Köszi a választ.
Időközben született egy megoldás ami úgy látszik működik:
Workbooks.Open Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\")) & "forrásadatok.xlsx"
Mostmár csak az a kérdés, hogy mindenképpen meg kell-e nyitnom ezt a fájlt ahhoz, hogy definiáljak benne egy tartományt,
Set rngTartomány = ActiveWorkbook.Worksheets(2).Range("C1:C51")
vagy lehet-e másképp is?
-
#18922
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Létezik a ThisWorkbook.Path ami visszaadja makrót tartalmazó munkafüzet elérési útját.
Nekem azonban az eggyel felljebb lévő alkönyvtár elérési útjára lenne szükségem, illetve egy abban az alkönyvtárban lévő fájlra szeretnék hivatkozni. Az nem megoldás, hogy fixen megadom az elérési utat mert az mindig változik.
Az a kérdésem, hogy van-e a képletek relatív hivatkozásához hasonló módszer erre a célra, vagy bűvészkedjek azzal, hogy a ThisWorkbook.Path által visszaadott sztringben az utolsó "\" utáni részt lecserélem a hivatkozni kívánt munkafüzet nevére?
-
#18416
m.zmrzlina
senior tag
pero19910606
#18410
m.zmrzlina
senior tag
válasz
pero19910606
#18410
üzenetére
Nekem is valami nagyon hasonlót sikerült kiötleni csak másképp töltöttem ki a táblázatot:
a képlet: (K2)
=HA(DARABTELI(B2:B32;"h")>10;DARABTELI(B2:B32;"x")*$N$2+10*$O$2+(DARABTELI(B2:B32;"h")-10)*$P$2;DARABTELI(B2:B32;"x")*$N$2+DARABTELI(B2:B32;"h")*$O$2) -
#18408
m.zmrzlina
senior tag
aPoFa
#18407
m.zmrzlina
senior tag
Én ennek egy lehetséges okáról tudok. (persze ha valóban nem állította senki a háttér és a betű szinét azonosra). Ez pedig az, hogy van egy olyan cellaformátum ami elrejti a cellatartalmat a munkalapon de a szerkesztőlécen megjeleníti. Ez pedig a ";;;" három pontosvesszővel beállítható egyéni formátumkód.
-
#18210
m.zmrzlina
senior tag
vamzi
#18208
m.zmrzlina
senior tag
Esetleg próbálkozz ezzel a (gondolatébresztő) saját függvénnyel:
Function HOLAKORTE(tartomany As Range, ertek_1 As Variant, ertek_2 As Variant)
For Each cella In tartomany
If cella.Value = ertek_1 And cella.Offset(0, -1).Value = ertek_2 Then HOLAKORTE = cella.Offset(0, -2).Value
Next
End FunctionHárom argumentumból az első az a tartomány amiben az ertek_1-et keresed (esetedben a C1:C9). Az ertek_1=100, az ertek_2="körte"
-
#18209
m.zmrzlina
senior tag
vamzi
#18208
m.zmrzlina
senior tag
Nekem ezzel a makróval (vagy valami nagyon hasonlóval) tűnik legegyszerűbbnek a feladat megoldása:
Sub holakorte()
For Each cella In Range("C1:C9")
If cella.Value = Range("E1").Value And cella.Offset(0, -1).Value = Range("F1").Value Then Range("G1").Value = cella.Offset(0, -2).Value
Next
End SubE1-ben és F1-ben adod meg a feltételeket. Az E1 ben lévő értéket fogja keresni a C oszlopban, az F1 értékét a B-ben és G1-be írja ki az eredményt.
-
#18137
m.zmrzlina
senior tag
motinka
#18135
m.zmrzlina
senior tag
válasz
motinka
#18135
üzenetére
Arra gondol, hogy ha tudod, hogy miből mit szeretnél csinálni akkor elindítod a makrórögzítést itt: (Excel2007 vagy újabb esetén)
Adsz neki egy nevet és végigcsinálod amit szeretnél majd leállítod. Ezután ha bármikor el szeretnéd végezni ugyanezt a feladatot csak kiválasztod az előbb rögzített makródat itt:
és lefuttatod.
De írd le pontosan mit szeretnél (esetleg képpel), hátha tudunk ötletet adni!
-
#18136
m.zmrzlina
senior tag
lapa
#18133
m.zmrzlina
senior tag
Itt egy lehetséges megoldás makróval:
Sub legnagyobb_hol()
For Each cella In Selection.Cells
datum = cella.Value
For Each cella_1 In Selection.Cells
If cella_1.Value = datum And cella_1.Offset(0, -1).Value > temp Then
legnagyobb_sor = cella_1.Row
temp = cella_1.Offset(0, -1).Value
End If
Next
For Each cella_2 In Selection.Cells
If cella_2.Value = datum Then
cella_2.Offset(0, 1).Value = temp
End If
Next
temp = 0
Next
End Sub"A" oszlopban vannak az értékek, "B" oszlopban a hozzájuk tartozó dátumok, "C"-ben pedig, hogy az adott dátumnál mi a legnagyobb érték.
Úgy indulsz, hogy kijelölöd a dátumokat tartalmazó cellákat az elsőtől az utolsóig. Ha a te munkalapod szerkezete nem ilyen (amire jó esély van
) akkor tegyél be egy képet és hozzáfaragjuk a makrót. -
#18083
m.zmrzlina
senior tag
Aladaar
#18081
m.zmrzlina
senior tag
válasz
Aladaar
#18081
üzenetére
Ha a cellákon belül van vegyesen szám és betű amiből csak a szám kell ahogyan a képen van akkor használd a következő makrót:
Sub csakaszamok()
For Each cella In Selection.Cells
For i = 1 To Len(cella.Value)
If Asc(Mid(cella.Value, i, 1)) > 47 And Asc(Mid(cella.Value, i, 1)) < 58 Then
csakaszam = csakaszam & Mid(cella.Value, i, 1)
End If
Next
cella.Offset(0, 1).Value = csakaszam
csakaszam = ""
Next
End SubTermészetesen a makró csak az elvet mutatja ha azt csinálja amit szeretnél akkor igény szerint faragható.
-
#18058
m.zmrzlina
senior tag
VIVANA
#18057
m.zmrzlina
senior tag
válasz
VIVANA
#18057
üzenetére
Az én egyik munkafüzetemben ez a pár sor végzi ezt a feladatot:
Sub rendez()
Dim lCount As Long
Dim lCount2 As Long
For lCount = 1 To Sheets.Count
For lCount2 = lCount To Sheets.Count
If Sheets(lCount2).Name < Sheets(lCount).Name Then
Sheets(lCount2).Move Before:=Sheets(lCount)
End If
Next lCount2
Next lCount
End SubA If Sheets(lCount2).Name < Sheets(lCount).Name Then sorban lévő "<" jellel tudod beállítani, hogy csökkenőbe vagy növekvőbe rendezzen.
Sajnos már nem tudom, hogy honnan loptam.
-
#18023
m.zmrzlina
senior tag
stupid user
#18020
m.zmrzlina
senior tag
válasz
stupid user
#18020
üzenetére
Próbáld meg kivenni a "Ha ez a teljes cella tartalma" elől kivenni a pipát.
-
#18022
m.zmrzlina
senior tag
DelArco
#18018
m.zmrzlina
senior tag
válasz
DelArco
#18018
üzenetére
Ha ez az "A1" képlete akkor valóban nem fog működni. De ha a worksheet change eseményébenmegadod, hogy mi történjen az "A1" értékével akkor jó lehet:
Private Sub Worksheet_Change(ByVal Target As Range)
If Cells(1, 1).Value = "" Then Cells(1, 1).Value = Cells(2, 1).Value
End SubEz akkor fog működésbe lépni amikor írsz, vagy törölsz valamit az "A1"-be(ből).
)
Bocsánat teljesen igazad van. A második ciklus helyesen így néz ki:
Új hozzászólás Aktív témák
Hirdetés
- One otthoni szolgáltatások (TV, internet, telefon)
- Fejhallgató erősítő és DAC topik
- Mobil flották
- Így nézz tévét 2025-ben: új ajánlások, régi szabályok
- Huawei Watch GT 2 Pro - egyszerűen gyönyörű
- Samsung Galaxy Watch6 Classic - tekerd!
- Tesla topik
- Asztalos klub
- Path of Exile (ARPG)
- Motorolaj, hajtóműolaj, hűtőfolyadék, adalékok és szűrők topikja
- További aktív témák...
- billentyűzetek - kiárusítás - Logitech, Corsair, ASUS
- Bowers/Wilkins PX8 fejhallgatók (dupla Bluetooth eszköz csatlakoztatása!) - ELKELTEK
- Csere-Beszámítás! Asztali számítógép PC Játékra. I5 12400F / RTX 3070 / 32GB DDR4 / 1TB SSD
- Crucial 240GB SSD eladó
- Telefon felvásárlás!! iPhone 12 Mini/iPhone 12/iPhone 12 Pro/iPhone 12 Pro Max
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged