- Megjelent a Poco F7, eurós ára is van már
- Szívós, szép és kitartó az új OnePlus óra
- Csak semmi szimmetria: flegma dizájnnal készül a Nothing Phone (3)
- Netfone
- Google Pixel 9 Pro XL - hét szűk esztendő
- Hivatalos a OnePlus 13 startdátuma
- One mobilszolgáltatások
- Nem fogy a Galaxy S25 Edge?
- Milyen okostelefont vegyek?
- Xiaomi 15 Ultra akku probléma?
-
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
-
#14835
Delila_1
veterán
marchello1
#14834
Delila_1
veterán
válasz
marchello1
#14834
üzenetére
Gondoltam, hogy nem ismered, azért ijedtél meg a feladat "nagyságától".
Szívesen.
-
Delila_1
veterán
A fájlok nevét az aktuális lap A oszlopába vittem fel, innen veszi a FileLista névre hallgató ListBox az adatokat. A kigyűjtést a CommandButton1 gombra bíztam.
Private Sub CommandButton1_Click()
Const utvonal = "E:\Eadat\" 'Írd át az útvonalat!
Dim FN As String, sor%
ChDir utvonal
FN = Dir(utvonal & "*.xls", vbNormal)
sor% = 1
Do
If FN <> "." And FN <> ".." Then
Cells(sor%, "A") = FN
sor% = sor% + 1
End If
FN = Dir()
Loop Until FN = ""
Set Rng = Range("A1")
Set Rng = Range(Rng, Rng.End(xlDown))
Me.FileLista.List = Rng.Value
FileLista.SetFocus
End Sub -
#14825
Delila_1
veterán
dellfanboy
#14814
Delila_1
veterán
válasz
dellfanboy
#14814
üzenetére
Ezt így nem tudod megoldani. Honnan tudja a gép, hogy a NOK és a Nokia azonos termékre vonatkozik?
Neked kell gondoskodnod arról, hogy jó adatokat vigyél be, akkor segít a gép. -
Delila_1
veterán
válasz
#45553408
#14821
üzenetére
Rosszul adtam meg a képletet, bocsi. Kárpótlásul mellékelek egy képet, amin 2 féle módon jelenítem meg a darabszámot. A C oszlopba jön az összefűzős képlet, a D és E erre hivatkozik.
D2: =DARABTELI(C:C;C2)
E2: =DARABTELI(C$2:C2;C2)Látod a különbséget, hogy a D oszlopban minden előfordulás mellé kiírja az összes előfordulás darabszámát, az E oszlopban pedig sorszámozza az előfordulásokat. Ezt a $ jellel lehet elérni.
-
Delila_1
veterán
Így más a leányzó fekvése.
Sub Osszevon()
Const utvonal = "D:\valami\"
Dim FN As String, WB As Workbook, lsz As Integer
Application.DisplayAlerts = False
Set WB = ActiveWorkbook
ChDir utvonal
FN = Dir(utvonal & "*.xls", vbNormal)
Do
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=FN
lsz = Sheets.Count
WB.Activate
ActiveSheet.Copy After:=Workbooks(FN).Sheets(lsz)
ActiveWorkbook.Save
ActiveWindow.Close
End If
FN = Dir()
Loop Until FN = ""
Application.DisplayAlerts = True
End Sub -
Delila_1
veterán
válasz
#45553408
#14816
üzenetére
Az A oszlopba másolod a neveket, B-be a számokat. A C2 képlete (címsort feltételezve)
=A2 & " " & B2 (szóköz van a két idézőjel között).
Ezt lemásolod az adataid utolsó soráig.
D2-be: =darabteli(B:B,A2), ezt is másold le. Minden sorban megmutatja, hogy az adott előadó ezzel a számával hányszor szerepel a listában. Ha 5-ször, akkor mind az 5 helyen kiírja. -
#14818
Delila_1
veterán
marchello1
#14810
Delila_1
veterán
válasz
marchello1
#14810
üzenetére
Megcsináltam az első 6 lapot. A technika:
- nyomva tartott Ctrl mellett a 06-os lapfület jobbra húzod
- felengeded az egér, gombját, majd a Ctrl billentyűt
- átnevezed a lapot 07-re
- a C5 cellában a 05-ös füzetre való hivatkozást átírod 06-ra.Jöhet a következő lap.
Jövőre 1 adatot kell átírni a 01-es lapon a C5-ös cellában, ott is csak az évszámot.
Nem olyan nagy munka!
Szerk.: egyszerre több kijelölt lapot is másolhatsz, de úgy könnyebb eltéveszteni.
-
#14802
Delila_1
veterán
marchello1
#14797
Delila_1
veterán
válasz
marchello1
#14797
üzenetére
Nézd meg a linken a cellák formátumát is.
-
Delila_1
veterán
A D:\valami\ könyvtárban található *.xls fájlokat nyitja meg, és az indító füzet (ebbe írd be a makrót) lapjai mögé másolja a behívott fájlok aktuális lapját, végül az indító fájlt lementi az eredeti helyére. Ez a fájl NE legyen azonos könyvtárban a behívandókkal.
Sub Osszevon()
Const utvonal = "D:\valami\"
Dim FN As String, WBN As String, lsz As Integer
Application.DisplayAlerts = False
WBN = ActiveWorkbook.Name
ChDir utvonal
FN = Dir(utvonal & "*.xls", vbNormal)
Do
lsz = Sheets.Count
If FN <> "." And FN <> ".." Then
Workbooks.Open Filename:=FN
ActiveSheet.Copy After:=Workbooks(WBN).Sheets(lsz)
Windows(FN).Activate
ActiveWindow.Close 'bezárás
End If
FN = Dir()
Loop Until FN = ""
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub -
Delila_1
veterán
válasz
repvez
#14785
üzenetére
Tehát előállítottad a personal.xlsm-ben a makródat.
Így rendelheted egy ikonhoz: a gyorselérési eszköztár jobb oldalán legördíted a nyilat, a "További parancsok"-at választod. A "választható parancsok helye" listából kiválasztod a Makrók-at. Az alatta lévő felsorolásban megtalálod a makródat, amit a Felvétel gombbal átmásolsz a jobb oldali listába. Ott a fel- és le nyíllal beteszed a kézre eső helyre. A makró nevén állva aktív lesz a lenti Módosítás gomb, amivel a fejlesztők által kreált rajzok között válogathatsz. Van itt pillangótól a vasmacskáig minden, csak olyan nincs természetesen, ami utalna a makród tartalmára.
-
Delila_1
veterán
A personalba írt kis makrótól kérdezem meg az aktuális cella karakter- és háttérszínét.
Sub Szin_lekerdezes()
MsgBox "Karakter: " & Selection.Font.ColorIndex & _
Chr(13) & "Háttér: " & Selection.Interior.ColorIndex
End SubIgaz, ez a ColorIndexet adja meg.
Kipróbáltam a makródat egy sárga hátterű cellán állva. Utána átállítottam ezt a sárgát a beállításoknál egy kislibazöldre, de ugyanazt az RGB összeállítást kaptam.
-
#14775
Delila_1
veterán
marchello1
#14774
Delila_1
veterán
válasz
marchello1
#14774
üzenetére
Szívesen.
-
#14773
Delila_1
veterán
marchello1
#14771
Delila_1
veterán
válasz
marchello1
#14771
üzenetére
Az előbb nem látszott a beszúrt képed.
A H3 és H5 képletét jobbra másolhatod az I oszlopba.
-
#14772
Delila_1
veterán
marchello1
#14771
Delila_1
veterán
válasz
marchello1
#14771
üzenetére
Szumha függvénnyel is megoldható.
-
Delila_1
veterán
válasz
repvez
#14757
üzenetére
A personal-ba tedd be a lenti pár sort, és rendeld egy ikonhoz.
Sub Lap_masol()
ActiveSheet.Unprotect
Cells.Copy Sheets("Másik_lap").Range("A1")
End SubA másolandó lapon állva rákattintasz az ikonra, és már másolja is a védett lap tartalmát a lapra, aminek a nevét beírtad a Másik_lap helyére.
A personalról, és az ikonhoz rendelésről több helyen volt már szó, keress rá, ha nem ismered.
Jó munkát! -
Delila_1
veterán
válasz
Balinov
#14752
üzenetére
Így első látásra
Windows("Benelux Backlog 20120827.xls").Activate
Windows("Consolidated Backlog Report_2808.xls").ActivateA két sor közül a második felülírja az elsőt. Az első a Benelux... fájlt teszi aktívvá, a második a Consolidated...-et.
A nagy halom ActiveWindow.ScrollColumn =... sor törölhető, azok csak követték a képernyőgörgetésedet, de a végükön a pl. Range("$A$1:$GP$27658") adja meg a tartományt, ahol végre kell hajtani valami utasítást.
-
Delila_1
veterán
2007-esben próbáltam ki.
Fejlesztőeszközök | Vezérlők | Beszúrás | ActiveX-vezérlők. Rákattintasz a jobb alsó sarokban lévő További vezérlők ikonra, mire kapsz róluk egy felsorolást. Ezek közül a Naptár vezérlőelem kell neked. A kapott szálkereszttel négyszöget rajzolsz. Jobb klikkre kapsz egy tulajdonságok ablakot, ahol mindenfélét formázhatsz rajta.
A menüszalagon kikapcsolod a Tervező módot.A lapfülön jobb klikk, Kód megjelenítése. A VB szerkesztőbe jutottál, itt a jobb oldali üres lapra másold be a makrót.
Két sort írok bele, amik közül csak az egyiket hagyhatod meg.
1. A lapodon lévő aktuális sor A oszlopába írja be a naptárban kiválasztott napot. Ezt az oszlopot a Cells(Selection.Row,1) 1-ese határozza meg. Kettesre átírva az akt. sor B oszlopába ír, és így tovább.2. A lapod bármelyik celláján állsz, kiválasztod a vezérlőn a dátumot, erre az aktuális celládban megjelenik a dátum.
Private Sub Calendar1_Click()
Cells(Selection.Row, 1) = Me.Calendar1.Value
Selection = Me.Calendar1.Value
End SubEgy másik makrót is írj a fenti alá (vagy fölé).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 3 Then
Me.Calendar1.Visible = True
Else
Me.Calendar1.Visible = False
End If
End SubEnnek az a feladata, hogy ha a C oszlop valamelyik cellájára klikkelsz, megjelenik a naptár vezérlő, más oszlopra lépve eltűnik. A C oszlopot a Target.Column=3 hármasa határozza meg.
-
Delila_1
veterán
Az összesített pontszámaid az S3:S52 tartományban vannak, ha jól értem.
Vegyél fel egy új oszlopot, a képlete legyen =S3+sor()*0,00001. A szorzónak elég kicsinek kell lennie, hogy semmiképp se adjon 1-es értéket. Ez a szám 10 pont esetén az 5. sorban 10,00005 lesz, a 14. sorban 10,00014. Erre az oszlopra hivatkozva az eredetileg azonos 10 pontos sorokat külön találja meg a kereső függvényed.
-
Delila_1
veterán
válasz
csferke
#14650
üzenetére
A Mutat makró ugyanaz, mint az Elrejt, csak az
If Cells(sor%, "D") = 0 Then Rows(sor%).EntireRow.Hidden = True
sor végén a True helyett legyen False.
A frissítő makród ilyen legyen:Private Sub Worksheet_Activate()
Mutat
ActiveSheet.PivotTables("PivotNenapFakt").PivotCache.Refresh
Elrejt
End Sub -
-
Delila_1
veterán
Fejlesztőeszközök | Visual Basic, vagy ehelyett Alt+F11-re bejön a VB szerkesztő.
Bal oldalon kiválasztod a füzetedet.
Az Insert menüben beszúrsz egy modult, mire a füzeted neve alatt kapsz egy Module1 nevű modult, amit kiválasztasz. Jobb oldalon lesz egy nagyobb üres felületet, ahova bemásolod a makrót.Az Excelbe visszalépve már alkalmazhatod az új függvényedet.
-
Delila_1
veterán
Írtam két függvényt rá.
1. Vegyük, hogy a szöveged az A1 cellában van. A C1-ben az =JobbVege(A1) függvény adja az eredményt.
Function JobbVege(szoveg As Range) As String
Dim b%
For b% = Len(szoveg) To 1 Step -1
If Mid(szoveg, b%, 1) = "-" Then
JobbVege = Right(szoveg, Len(szoveg) - b%)
Exit Function
End If
Next
End Function2. Nem írtad, de lehet, hogy a szöveg bal oldalát is ki kell íratnod. A B1-ben az =BalEleje(A1;C1) függvény megteszi ezt.
Function BalEleje(teljes As Range, jobb As Range) As String
BalEleje = Left(teljes, Len(teljes) - Len(jobb) - 1)
End FunctionBár az utóbbit az Excel saját függvényeivel is beírhatod.
=BAL(A1;HOSSZ(A1)-HOSSZ(C1)-1) -
Delila_1
veterán
válasz
pirit28
#14578
üzenetére
A makróban a $A$1 helyére azt a cellacímet írd, amitől megváltozik a SUM értéke, mert a makró a billentyűzetről történő bevitelt figyeli.
Ha egy tartománytól függ az A1 értéke, akkor ilyen legyen a makród:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1:C20")) Is Nothing Then Then Range("C1") = Format(Now(), "hh:mm:ss")
End SubEz a B1:C20 tartományban történt változás következtében írja be a C1-be az időt. Ehelyett add meg a saját összegzendő tartományodat.
-
Delila_1
veterán
válasz
csferke
#14569
üzenetére
Szia!
Meg is kell jelenítenie, hiszen csak a D=0 sorokat rejti el a makró, a negatívakat nem. Kipróbáltam, bár a makrót nézve is látszott, hogy negatív D értéknél nem rejti el a sorokat.
A kimutatásban a D oszlopban vannak az értékek? Ha nem, az
If Cells(sor%, "D") = 0 Then Rows(sor%).EntireRow.Hidden = True
sorban írd át a "D"-t a megfelelő oszlop betűjelére.
-
#14556
Delila_1
veterán
Bocimaster
#14555
Delila_1
veterán
válasz
Bocimaster
#14555
üzenetére
-
#14554
Delila_1
veterán
Bocimaster
#14553
Delila_1
veterán
válasz
Bocimaster
#14553
üzenetére
Nem kell neki a kiterjesztés.
-
Delila_1
veterán
válasz
lacipapi
#14545
üzenetére
Két szövegdobozt vettem fel. Az egyik szövege "Mentve", ennek az M nevet adtam. A másiké "Másolatként mentve", ez az Mm névre hallgat.
A makróban a két Loop While kezdetű sorban állítsd az időt a saját géped sebességéhez.
Sub Masolat()
Dim WB As Workbook, FN As String, kiterj As String, kezd As Long
Set WB = ActiveWorkbook
FN = WB.Name
kiterj = Right(FN, Len(FN) - Application.WorksheetFunction.Search(".", FN) + 1)
FN = Left(FN, Len(FN) - Len(kiterj))
ActiveSheet.Shapes("Mm").Visible = False
ActiveSheet.Shapes("M").Visible = False
Application.DisplayAlerts = False
If InStr(FN & kiterj, "masolat") Then
WB.Save
ActiveSheet.Shapes("M").Visible = True
Calculate
kezd = 1
Do
kezd = kezd + 1
Loop While kezd < 10 ^ 7
ActiveSheet.Shapes("M").Visible = False
Else
WB.SaveAs FN & "_masolat" & kiterj
ActiveSheet.Shapes("Mm").Visible = True
Calculate
Do
kezd = kezd + 1
Loop While kezd < 10 ^ 7
ActiveSheet.Shapes("Mm").Visible = False
End If
Application.DisplayAlerts = True
End Sub -
-
#14543
Delila_1
veterán
Fire/SOUL/CD
#14540
Delila_1
veterán
válasz
Fire/SOUL/CD
#14540
üzenetére
Két képlettel is 11-et ad.
-
#14539
Delila_1
veterán
Fire/SOUL/CD
#14537
Delila_1
veterán
válasz
Fire/SOUL/CD
#14537
üzenetére
A kérdés feltevője nem akart C oszlopot, a {=NÉGYZETÖSSZEG(A1:A4-B1:B4)} képlet csak az első két oszlopból számol, és 11-et ad eredményül.
-
Delila_1
veterán
válasz
Delila_1
#14536
üzenetére
Javítás:
Sub Masolat()
Dim WB As Workbook, FN As String
Set WB = ActiveWorkbook
FN = Left(WB.Name, Len(WB.Name) - 5)
Application.DisplayAlerts = False 'kérdés letiltása
If InStr(FN, "masolat") Then
WB.Save
Else
WB.SaveAs FN & "_masolat"
End If
Application.DisplayAlerts = True 'kérdés engedélyezése
End Sub -
Delila_1
veterán
válasz
lacipapi
#14530
üzenetére
Másik módszer a másolathoz:
Sub Masolat()
Dim WB As Workbook, FN As String
Set WB = ActiveWorkbook
FN = WB.Name
Application.DisplayAlerts = False 'kérdés letiltása
WB.SaveAs Left(FN, Len(FN) - 5) & "_másolat"
Application.DisplayAlerts = True 'kérdés engedélyezése
End Sub -
#14535
Delila_1
veterán
Fire/SOUL/CD
#14532
Delila_1
veterán
válasz
Fire/SOUL/CD
#14532
üzenetére
Nálam 11 volt az eredmény.
-
#14527
Delila_1
veterán
Fire/SOUL/CD
#14526
Delila_1
veterán
válasz
Fire/SOUL/CD
#14526
üzenetére
Ez sem jó. Egyesével elvégezve a kivonást más eredményt ad, mint ez.
Rhino666
Megvan!
{=NÉGYZETÖSSZEG(A1:A4-B1:B4)} -
Delila_1
veterán
válasz
Rhino666
#14519
üzenetére
Az eredmény ugyanaz, így is, úgy is 3, aminek a négyzete 9.
Szerk.:
Közben rájöttem, hogy nem mindegy. A C1 képlete =A1-B1, ezt lemásolod C4-ig.
Az eredményt a {=NÉGYZETÖSSZEG(C1
4)} képlettel számolhatod ki. A francia zárójelek úgy adódnak hozzá a képletedhez, hogy Shift+Ctrl+Enterrel viszed be, mert ez egy tömbképlet. -
Delila_1
veterán
válasz
#26949760
#14498
üzenetére
Rajzold meg a jelölőt az Űrlap eszköztárról. Modulba vidd be a makrót.
Sub Jelölőnégyzet1_Kattintáskor()
Dim lap As Integer
Calculate
For lap = 1 To Worksheets.Count
Sheets(lap).Select
Cells.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
End Sub -
Delila_1
veterán
válasz
csferke
#14475
üzenetére
Meg lehet oldani. A laphoz kell rendelned az alábbi makrót.
Private Sub Worksheet_Activate()
ActiveSheet.PivotTables("Kimutatás1").PivotCache.Refresh
Elrejt
End SubMikor a kérdéses lapra lépsz, ennek a makrónak az első sora frissíti a kimutatást. Ha nem Kimutatás1 a neve, írd át.
A második sor meghívja az Elrejt makrót. -
Delila_1
veterán
-
-
Delila_1
veterán
válasz
lacid90
#14457
üzenetére
Nem értem, mit is akarsz végrehajtani. A két gombhoz rendelt makróval a SumColor makrót hívod meg, de a szinek makrót akarod indítani.
A gombhoz rendelt makrókban értéket adsz két változónak (szin, le). Ezeket a pillanatnyi értékeket át kell adnod a meghívott, szinek makrónak.
Így csináld:
Private Sub CommandButton1_Click() 'v.zöld 35
szin = 35: le = 1
szinek szin, le 'a változók megadásával hívod meg a szinek makrót
End Sub
Sub szinek(szin, le)
Application.ScreenUpdating = False 'a képernyőfrissités kikapcsolása (makró gyorsítás)
Dim CV As Range, usor As Long
oszl = ActiveCell.Column
ActiveCell.Interior.ColorIndex = szin
...
...
Application.ScreenUpdating = True
ActiveCell.Offset(le).Activate
End Sub -
Delila_1
veterán
válasz
csferke
#14459
üzenetére
Az 1. lapra betennék egy új oszlopot, ami a számlázott-, és a befizetett összeg különbségét adja. Az adatokat az adatlapon is rendezheted, de a kimutatásban is.
A kimutatás sorába kerül a cég neve és a számlaszám, az adatokhoz ez a különbség. Itt még megjelennek a nulla tartozást mutató sorok. Ezeknek az eltüntetéséhez írtam egy kis makrót, amit egy gombhoz rendelhetsz.
Sub Elrejt()
Dim sor%, usor%
usor% = Cells(Rows.Count, "A").End(xlUp).Row
sor% = usor%
For sor% = usor% To 5 Step -1
If Cells(sor%, "C") = 0 Then Cells(sor%, "B").Delete
Next
End Sub -
#14454
Delila_1
veterán
foregister
#14449
Delila_1
veterán
válasz
foregister
#14449
üzenetére
Most látom, hogy az első érvényesítés képletét elírtam a magyarázó szövegben, de nyilván észrevetted, és a második C2 helyett C3-at adtál meg.
-
Delila_1
veterán
válasz
bozsozso
#14447
üzenetére
Egy füzet két lapján csináltam meg, de biztosan nem jelent gondot 2 füzetre átírni.
A lényeg, hogy az A és B oszlop adatait összefűzöm, és azt kerestetem. Érdemes közéjük pl. egy szóközt tenni, mert a 112 és 15 közvetlenül összefűzve ugyanazt az eredményt adja, mint a 11 és 215 összefűzése.
Új hozzászólás Aktív témák
Hirdetés
Fferi50- HDD probléma (nem adatmentés)
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- LEGO klub
- Asustor NAS
- Fejhallgató erősítő és DAC topik
- Renault, Dacia topik
- Megjelent a Poco F7, eurós ára is van már
- Eredeti játékok OFF topik
- ASZTALI GÉP / ALKATRÉSZ beárazás
- Kormányok / autós szimulátorok topikja
- További aktív témák...
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Assassin's Creed Shadows Collector's Edition PC
- Gyermek PC játékok
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Tablet felvásárlás!! Apple iPad, iPad Mini, iPad Air, iPad Pro
- Azonnali készpénzes Microsoft XBOX Series S és Series X felvásárlás személyesen/csomagküldéssel
- ÁRGARANCIA! Épített KomPhone i5 12400F 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
- ÁRGARANCIA! Épített KomPhone i5 12400F 16/32/64GB RAM RTX 5060 8GB GAMER PC termékbeszámítással
- AKCIÓ! ASUS B460M i7 10700 16GB DDR4 512GB SSD GTX 1080Ti 11GB KOLINK Observatory TG TT 600W
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: PC Trade Systems Kft.
Város: Szeged