-
Fototrend
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
veterán
válasz
azopi74
#26475
üzenetére
Szerinted miből van több? Multiból, vagy egyébből?
"...szerintem általánosan a topicban ésszerűbb lenne amúgy is áttérnünk annak a használatára - legalább a függvényeknél"
Igazad van, használjunk angolt, és hétfőn is legyenek zárva a boltok, hiszen akkor én sohasem vásárolok be.
![;]](//cdn.rios.hu/dl/s/v1.gif)
Nem kell külön progi, elég, ha beszúrsz egy nemzetközi makrólapot.
-
Delila_1
veterán
válasz
azopi74
#26467
üzenetére
Elég sok országban élő Excel alkalmazóval van kapcsolatom, minden országban lefordították.
Szerintem ha válaszolni akarsz a kérdésekre, mindenkinek azon a nyelven írd a függvényeket, ahogy a kérdező kéri. Másképp nincs értelme a segítségnek, nem segítség, hanem bosszantás.
-
Delila_1
veterán
Most tetszőleges név, és tetszőleges terület esetén is elkészíti a beosztást. Nincs benne viszont, hogy minden terület legalább 1× szerepeljen. Nem minden esetben van megfelelő megoldás, pl. ha sok az eszkimó (ember), és kevés a fóka (terület).
Sub Terulet()
Dim sor As Integer, oszlop As Integer, vel As Integer, i As Integer, soruj As Integer
Dim NevUsor As Long, TerUsor As Long
Dim tomb()
NevUsor = Range("A" & Rows.Count).End(xlUp).Row
TerUsor = Range("G" & Rows.Count).End(xlUp).Row
ReDim tomb(1 To TerUsor)
Application.ScreenUpdating = False
Range("B4:E" & NevUsor) = ""
For sor = 4 To NevUsor
UjSor:
For oszlop = 2 To 5
UJRA:
Randomize
vel = Round(Rnd() * (TerUsor - 3) + 3, 0) '
If tomb(vel) > 0 Then GoTo UJRA ' Ha volt már a sorszám, akkor újra generál
tomb(vel) = 1
Next
oszlop = 2
For i = 1 To TerUsor 'Beírja a területet, lenullázza a tömböt
If tomb(i) = 1 Then
Cells(sor, oszlop) = Cells(i, "G")
oszlop = oszlop + 1
End If
tomb(i) = 0
Next i
For soruj = 3 To TerUsor 'Van-e 3× a terület?
If Application.CountIf(Range("$B$4:$E" & NevUsor), Range("G" & soruj)) > 3 Then
Range("B" & sor & ":E" & sor) = ""
For i = 1 To TerUsor
tomb(i) = 0
Next
GoTo UjSor
Exit For
End If
Next
Next
Application.ScreenUpdating = True
End Sub -
-
#26459
Delila_1
veterán
Gravity1234
#26457
Delila_1
veterán
válasz
Gravity1234
#26457
üzenetére
COUNTA
Megszámolja, hány cellában van valamilyen adat.
-
#26456
Delila_1
veterán
kőbaltazár
#26453
Delila_1
veterán
válasz
kőbaltazár
#26453
üzenetére
Attól függ, melyik verziót használod.
2007-től van mód a szín szerinti szűrésre, a szűrt cellákat pedig összegezheted a RÉSZÖSSZEG függvénnyel.
Korábbi verzióhoz keress itt rá a SumColor kifejezésre.
-
Delila_1
veterán
A makró összeállítja a területek kiosztását.
Sub Terulet()
Dim sor As Integer, oszlop As Integer, vel As Integer, i As Integer, soruj As Integer
Dim tomb(1 To 36) As Integer
Application.ScreenUpdating = False
Range("B4:E23") = ""
For sor = 4 To 23
UjSor:
For oszlop = 2 To 5
UJRA:
Randomize
vel = Round(Rnd() * 33 + 3, 0) '3 és 36 közötti véletlenszámot ad
If tomb(vel) > 0 Then GoTo UJRA ' Ha volt már a sorszám, akkor újra generál
tomb(vel) = 1
Next
oszlop = 2
For i = 1 To 36 'Beírja a területet, lenullázza a tömböt
If tomb(i) = 1 Then
Cells(sor, oszlop) = Cells(i, "G")
oszlop = oszlop + 1
End If
tomb(i) = 0
Next i
For soruj = 3 To 36 'Van-e 3× a terület?
If Application.CountIf(Range("$B$4:$E$23"), Range("G" & soruj)) > 3 Then
Range("B" & sor & ":E" & sor) = ""
For i = 1 To 36
tomb(i) = 0
Next
GoTo UjSor
Exit For
End If
Next
Next
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
aviator
#26427
üzenetére
Gondolom, az időértéket tartalmazó cellák szöveg formátumúak, azért kell a ":"-ot keresni bennük.
Kijelölöd az oszlopot, és indítod a makrót.Sub Kijelol()
Dim CV As Object, ter As String
For Each CV In Selection
If CV = "" Then
Exit For
Else
If InStr(CV, ":") > 0 Then ter = ter & CV.Address & ","
End If
Next
ter = Left(ter, Len(ter) - 1)
Range(ter).Select
End Sub -
Delila_1
veterán
válasz
Zola007
#26424
üzenetére
Újra elolvastam az eredeti kérdést, így már csak a területet kell átírnod a makróban.
Sub csere()
Dim Cella As Range, b As Integer
For Each Cella In Range("A1:A3") '*****
If InStr(Cella.Value, "*") > 0 Then
For b = 1 To Len(Cella)
If Mid(Cella, b, 1) = "*" Then
Cella.Characters(Start:=b, Length:=1).Font.Color = -16776961
End If
Next
End If
Next
End SubHa biztos, hogy cellánként csak egy csillag van, akkor
Sub csere_1()
Dim Cella As Range, hol As Integer
For Each Cella In Range("A1:A3") '*****
On Error Resume Next
hol = InStr(Cella.Value, "*")
Cella.Characters(Start:=hol, Length:=1).Font.Color = -16776961
Next
End Sub -
Delila_1
veterán
válasz
Zola007
#26424
üzenetére
A lenti makró az A1:A3 tartományban írja át az a betűket pirosra.
Sub csere()
Dim Cella As Range, b As Integer
For Each Cella In Range("A1:A3") '***** 1
If InStr(Cella.Value, "a") > 0 Then '***** 2
For b = 1 To Len(Cella)
If Mid(Cella, b, 1) = "a" Then '***** 3
Cella.Characters(Start:=b, Length:=1).Font.Color = -16776961 '***** 4
End If
Next
End If
Next
End SubA csillagos sorokban kell módosítanod.
1. a területet az "A1:A3" helyére
2. és 3. a keresendő szöveget az "a" helyére
4. a Lenght:=1 -ben az 1 helyett a saját átszínezendő szöveged hosszát -
#26421
Delila_1
veterán
Illusion1010
#26420
Delila_1
veterán
válasz
Illusion1010
#26420
üzenetére
-
#26419
Delila_1
veterán
Illusion1010
#26418
Delila_1
veterán
válasz
Illusion1010
#26418
üzenetére
A2-től a táblázat jobb alsó cellájáig add meg az érvényességet a szabályok kezelésénél.
-
#26417
Delila_1
veterán
Illusion1010
#26416
Delila_1
veterán
válasz
Illusion1010
#26416
üzenetére
Valószínűleg kihagytad a $ jeleket a képletből, amik rögzítik az adott oszlopra történő hivatkozást.
-
#26412
Delila_1
veterán
Illusion1010
#26411
Delila_1
veterán
válasz
Illusion1010
#26411
üzenetére
A képletet a teljes tartomány kijelölése után add meg.
-
#26409
Delila_1
veterán
Illusion1010
#26408
Delila_1
veterán
válasz
Illusion1010
#26408
üzenetére
=ÉS($J2="X";$K2=2;$N2<50;$O2>60)
a képlet a feltételes formázásban.
-
#26375
Delila_1
veterán
m.zmrzlina
#26374
Delila_1
veterán
válasz
m.zmrzlina
#26374
üzenetére
On Error Resume Next
Workbooks.Open Filename:="Elérési_út\FájlNeveKiterjesztéssel" -
Delila_1
veterán
válasz
karlkani
#26332
üzenetére
Ismered a fényképezőgép ikont?
Ennek a segítségével a képernyőn éppen nem látható, távoli cellát teheted állandóan láthatóvá, illetve olyan helyre vetíted ki, ahol éppen jársz. Területet is kijelölhetsz vele.
Mint látod, a képletet a képernyőn pillanatnyilag nem látható E41 cella tartalmazza, és a B oszlop első 12 értékét összegzi. Követi a változásokat.
-
Delila_1
veterán
Ilyenkor kell lekérdezni a kódját. Beírod az Ű-t egy cellába, és a KÓD függvénnyel hivatkozol erre a cellára.
=kód(a1)Értékként 219-et kapsz. A makróban a csere így módosul:
Cells.Replace What:="körte", Replacement:=Chr(219) & "valami", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=FalseFájlnévben nem érdemes ékezetes betűket alkalmazni.
-
Delila_1
veterán
válasz
karlkani
#26317
üzenetére
"Valamint olyan cella változását képes figyelni, melyet nem én módosítok, hanem néhány cella tartalmát összegzi, s, ha változás van, azt jelezze egy cellában nekem?"
Azokat a cellákat kell figyeltetned, amik az összegző cella értékét módosítják.
Például a B5:B20 tartomány összegzésénélIf Not Intersect(Target, [B5:B20]) Is Nothing Then
-
Delila_1
veterán
Az a füzet, mivel makrót tartalmaz, xlsm kiterjesztésű, annak az egynek nyitva kell lennie, hiszen abból indítod a makrót. A többi xlsx kiterjesztésű, azokat nyitja meg sorban.
A többi első lapján kicseréli a szövegeket, most már kipróbáltam. Lehet, hogy nem az első lapon kel csere-berélni?
-
Delila_1
veterán
Próba nélkül!
Sub Csere()
Dim utvonal As String, FN As String
Application.DisplayAlerts = False
utvonal = "F:\Eadat\" '*****
FN = Dir(utvonal & "*.xlsx")
Do While FN <> ""
Workbooks.Open utvonal & FN
Sheets(1).Select '*****
Cells.Replace What:="régi szöveg", Replacement:="új szöveg", LookAt:=xlPart, _ '*****
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.Save
ActiveWindow.Close
FN = Dir()
Loop
Application.DisplayAlerts = True
End SubA makró az utvonal változóban megadott mappából sorban megnyitja az ott lévő, *.xlsx kiterjesztésű füzetet.
A Sheets(1).Select sor ráállítja a füzetben lévő első lapra.
A cserét az ezután következő, 3 soros utasítás végzi el, majd a megnyitott füzetet menti és bezárja.Három helyre tettem csillagokat, ahol az útvonalat, a megnyitott füzet első lapját, és a "mit cseréljen mire" szövegeket kell megváltoztatnod.
A makrót léptetve próbáld ki 2 füzeten – VB szerkesztőben F8-cal léptetve, majd leállítva. Ha megfelel, a makró elejére beszúrhatsz egy sort, ami leállítja a képernyőfrissítést, ezzel gyorsítva a futást.
Application.ScreenUpdating = False
A makró végén ezt vissza kell állítani.
Application.ScreenUpdating = True
-
Delila_1
veterán
válasz
jkoczor
#26306
üzenetére
Az Adatok | Kapcsolatok | Hivatkozások menüben a Váltás gomb engedi kitallózni az új mappát, és fájlnevet. Ez módosítja a füzetben lévő, előző helyre és fájlra történt hivatkozásokat.
Szerk.:
Közben kipróbáltam. Tettem be egy hivatkozást másik füzetből. Mindkét füzetet bezártam, a 2. füzetet áttettem más mappába. A hivatkozást tartalmazót megnyitottam. Azonnal dobott egy ablakot, ahol módosíthattam a csatolást. -
Delila_1
veterán
válasz
Gandalf80
#26297
üzenetére
Másik megoldás, mikor a dátumot és a műszakot kiválasztva a H1 és H2 cellában, a H4 érvényesítésében a választásnak megfelelő nevek jelennek meg.
Itt is elrejthető a J oszlop, az L-ben pedig bővíthető a névlista. Ez utóbbi a C oszlop érvényesítéseiben jelenik meg.
-
Delila_1
veterán
válasz
lokos19
#26192
üzenetére
For Each cell In Range(ter)
If cell.Interior.ColorIndex = 6 Then Cells(5, 5) =Cells(5, 5) +cell.value 'sárga
If cell.Interior.ColorIndex = 5 Then Cells(5, 12) =Cells(5, 12) +cell.value 'kék
If cell.Interior.ColorIndex = 3 Then Cells(5, 15) =Cells(5, 15) +cell.value 'piros
Next -
-
Delila_1
veterán
válasz
Fferi50
#26150
üzenetére
Van táblázat a 2003-ban, sőt előtte is, csak ott listának nevezték.
Eddig úgy tudtam, az a lényeg ennél a szűrésnél, hogy megegyezzenek a mezőcímek, de látod, Hhheninél összejött.
"...úgy tudtam megoldani, hogy fölvettem egy "többet" nevű fiktív mezőt, alá d2<k2, és tökéletesen működik"
Nálam az ab.darab2(...) sem jött így össze.
-
Delila_1
veterán
Rosszul írtam a két oszlop formátumát.
A G és H oszlop formátuma
(p):mm, jobbra behúzva, behúzás 1.
A szögletes zárójelek nélkül nem mutatná az eltelt órákat a két időpont között. Ezzel igen, percbe átszámolva.Szerk.: a szögletes zárójelet a fórummotor lekerekíti, de a szögletes kell.
-
Delila_1
veterán
A kezdés idejét a rajzszám beírásához rendeltem. Ha az A-hoz is beírnám, akkor eltelik némi idő (pláne, ha közben az adatrögzítő megiszik egy kávét) a rendelés bevitele után, és úgyis felülírná az egyszer már beírt kezdést.
A D, G, és H oszlop megadását is csak az F-hez kötöttem, nincs értelme az E-hez is megadni.
A G és H oszlop formátuma p:mm, jobbra behúzva, behúzás 1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column = 2 Then Cells(Target.Row, "C") = Now
If Target.Column = 6 Then
Cells(Target.Row, "D") = Now
Cells(Target.Row, "G") = Cells(Target.Row, "D") - Cells(Target.Row, "C")
Cells(Target.Row, "H") = Cells(Target.Row, "G") / Cells(Target.Row, "F")
End If
End Sub -
Delila_1
veterán
Induljunk el a kályhától.
Mikor mit csináljon a makró?Beírod a rendelés számát, majd a rajzszámot. Ekkor írja be a kezdés idejét a C-be?
Mikor írja be a befejezés idejét a D-be? Mikor az F-ben megadod a legyártott darabok számát?A G2 képlete =D2-C2 legyen, percben megadva, és ebből számolja ki a H a darabidőt? Ezt a darabszám megadásakor (F) végezheti.
-
Delila_1
veterán
válasz
hhheni
#26128
üzenetére
Fiktívnek azt nevezném, amit beírsz a kritériumtáblába, de az eredeti táblában nem szerepel. Erre nem tud szűrni az irányított-, vagy speciális szűrő.
Ha az eredeti táblába veszel fel egy új oszlopot, ahol bizonyos számításokat, összehasonlításokat végzel, az egy segédoszlop, része lesz a táblázatodnak, lehet rá szűrni.
Csakis a fiktív elnevezéssel nem értek egyet.
-
-
Delila_1
veterán
válasz
cellpeti
#26094
üzenetére
A lenti makró bekéri a keresendő szöveget, és az összes lapon kipirosítja ezeknek a hátterét.
Sub Piros()
Dim lap As Integer, ter As Range, keres As String
Dim CV As Object
keres = Application.InputBox(prompt:="Kérem a keresendő szöveget", Type:=2)
For lap = 1 To Worksheets.Count
Sheets(lap).Activate
Set ter = Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, _
ActiveSheet.UsedRange.Columns.Count))
For Each CV In ter
If CV = keres Then Range(CV.Address).Interior.ColorIndex = 3
Next
Next
End Sub -
Delila_1
veterán
válasz
anti01
#26074
üzenetére
Lemaradt a kép.
A logika, "Ha B3="" akkor törölje B,C,D oszlopot, ha E3="" akkor törölje F, G, H oszlopokat" nem egészen tiszta. Az elsőbe beleesik a vizsgált oszlop a 3 törlendőbe, a másodiknál nem.
Nekem az sem világos, hogy soronként kell-e vizsgálni. Ha igen, akkor bukfenc, mert ha a 3. sort nézve kitörlünk oszlopokat, olyan oszlopot is törölhetünk, ahol az n-edik sorban a fenti feltételek nem igazak.
-
Delila_1
veterán
-
#26038
Delila_1
veterán
Csuklósbusz
#26037
Delila_1
veterán
válasz
Csuklósbusz
#26037
üzenetére
A második lapnak csupán annyi értelme van, hogy kiszűri azokat a címeket, neveket, ahol nincs megrendelés.
Az új változat 1 lapon végzi el ezt a feladatot.
[link]
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Fallout 4 Pip-Boy Edition eladó
- Xbox / Microsoft Store feltöltőkártya kód (digitális, HU) több címlet, több db, azonnal, olcsón
- Samsung Galaxy S24 Ultra 12/256 GB Titanium Gray 6 hónap Garancia Beszámítás Házhozszállítás
- Rendelésre: Apple Mac Studio M2 Ultra 24/60 mag, 64GB RAM, 1TB SSD - 27% ÁFA
- Xbox One S All Digital 1 TB + kontroller 6 hó garancia, számlával!
- Használt 1TB NVME SSD-k.
- szinteÚJ! Microsoft Surface Laptop 5 13.5" i5-1245U 16GB 512GB Alcantara 1év garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest