- Apple iPhone 16 Pro - rutinvizsga
- Honor Magic6 Pro - kör közepén számok
- Mobil flották
- Samsung Galaxy A54 - türelemjáték
- Garmin Forerunner 970 - fogd a pénzt, és fuss!
- Hammer 6 LTE - ne butáskodj!
- Xiaomi 11 Lite 5G NE (lisa)
- Milyen okostelefont vegyek?
- Huawei Watch Fit 3 - zöldalma
- One mobilszolgáltatások
-
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
-
#11367
m.zmrzlina
senior tag
Padam
#11364
m.zmrzlina
senior tag
Javított verzió
aminek mindegy, hogy a B3:C18 tartományon kívül mit hová szeretnél beírni:Private Sub Worksheet_Change(ByVal Target As Range)
Dim cella As Range
If Not Application.Intersect(Target, Range("B3:C18")) Is Nothing Then
For Each cella In Range("B3:C18").Cells
If Not cella.Address = Target.Address And Target.Value <> "" Then
If cella.Value = Target.Value Then
MsgBox Target.Value & " erre az időpontra nem osztható be!"
Target.Value = ""
Exit Sub
End If
End If
Next
End If
End Sub -
#11366
m.zmrzlina
senior tag
Padam
#11364
m.zmrzlina
senior tag
-
#11365
m.zmrzlina
senior tag
Padam
#11364
m.zmrzlina
senior tag
Első körben próbáld a következő makrót a kérdéses munkalaphoz rendelni:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cella As Range
For Each cella In Range("B3:C18").Cells
If Not cella.Address = Target.Address And Target.Value <> "" Then
If cella.Value = Target.Value Then
MsgBox Target.Value & " erre az időpontra nem osztható be!"
Target.Value = ""
Exit Sub
End If
End If
Next
End Sub -
#11310
m.zmrzlina
senior tag
pitman
#11307
m.zmrzlina
senior tag
válasz
pitman
#11307
üzenetére
Ha erre gondolsz, akkor az ActiveSheet.Name helyett próbálj meg Sh.Name-t használni.
Így:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox "A(z) " & Sh.Name & " munkalapon a " & Target.Row & ". sor és a(z) " & Target.Column & ". oszlop" & Chr(10) & " metszéspontjában lévő cella módosult!"
End SubNem használtam még ezt a módszert de az argumentumokból ez következik.
-
#11266
m.zmrzlina
senior tag
Angerfis
#11264
m.zmrzlina
senior tag
válasz
Angerfis
#11264
üzenetére
Szerintem sem kell feltétlenül makró.
Itt is van egyféle megoldás.
-
#11241
m.zmrzlina
senior tag
pitman
#11240
m.zmrzlina
senior tag
válasz
pitman
#11240
üzenetére
Vagy én értek valamit félre vagy te. Nekem a másik feltétel is működik:
Ha üres cellát is el lehet fogadni az 1 vagy 2 helyett akkor módosítani kell a képletet:
=VAGY(HA(ÉS(B1<>"M";SZÁM(HOL.VAN(B2;H2:I2;0)));VAGY(B5=1;B5=""));HA(ÉS(B1="M";SZÁM(HOL.VAN(B2;J2:K2;0)));VAGY(B5=2;B5="")))
Az elírást én is észrevettem a képletet is ennek figyelembe vételével csináltam meg.
-
#11235
m.zmrzlina
senior tag
danih
#11234
-
#11233
m.zmrzlina
senior tag
pitman
#11231
m.zmrzlina
senior tag
válasz
pitman
#11231
üzenetére
Én is ezen gondolkoztam, hogy viszonylag jól körülhatárolt feltételek alapján lehet a bevihető adat 1 vagy 2 akkor minek az érvényesítés de ha ez kell ám legyen.
Ezt tedd a képletbe:
=VAGY(HA(ÉS(B1<>"M";SZÁM(HOL.VAN(B2;H2:I2;0)));B5=1);HA(ÉS(B1="M";SZÁM(HOL.VAN(B2;J2:K2;0)));B5=2))
A kérdés második felére:
Van a Workbook objektumnak SheetChange eseménye:Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox "A(z) " & ActiveSheet.Name & " munkalapon a " & Target.Row & ". sor és a(z) " & Target.Column & ". oszlop" & Chr(10) & " metszéspontjában lévő cella módosult!"
End SubSosem használtam még de kipróbáltam és úgy tűnik működik.
Jobbklikk a ThisWorkbook-on majd View Code helyre másolni. -
#11230
m.zmrzlina
senior tag
pitman
#11229
m.zmrzlina
senior tag
válasz
pitman
#11229
üzenetére
A kérdésed első részét légy szíves illusztráld képpel és a kérdéses fv-nyel mert így az az érzésem, hogy nagyon messziről fogunk nekiindulni.
A változtatott cella sorát a Target.Row-val az oszlopát a Target.Column-nal tudod lekérdezni.
Pl:Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "A(z) " & Target.Row & ". sor és a(z) " & Target.Column & ". oszlop" & Chr(10) & " metszéspontjában lévő cella módosult!"
End SubArra figyelj, hogy ezt nem új modulba kell másolni, hanem ahhoz a munkalaphoz kell rendelni amin a változást akarod figyelni. Jobbkatt a munkalap fülön majd Kód megjelenítése opció.
Biztos van más módszer is, én így szoktam csinálni.
-
#11220
m.zmrzlina
senior tag
Delila_1
#11219
m.zmrzlina
senior tag
válasz
Delila_1
#11219
üzenetére
pitman-nak válaszoltam mert írta, hogy neki működik az FKERES() amit a #11211-ben kérdeztem. Gondolom begépelte a számokat, úgy nekem is működött.
A képleted a "2" karaktert távolítja el. 2017-ből 017 lesz.
Sőt a KÓD() akkor is 50-et ad ha az eredeti cellatartalomra írom be meg akkor is ha a <Backspace>-szel preparáltra.
-
#11218
m.zmrzlina
senior tag
pitman
#11217
m.zmrzlina
senior tag
-
#11211
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Nem tudom használni az FKERES()-t
Az E:F oszlopok egy "adatbázis" ahol a tételek mellett azonosítószám van. Az A:B oszlopok ennek az adatbázisnak egy részhalmaza ahol lehetnek olyan hibák, hogy az azonosítószám mellett nem a megfelelő tételek vannak (a példában ökör,ló)
Szeretnék egy FKERES()-t a C oszlopba ami az A oszlop azonosítóit kikeresi az E oszlopban és az F oszlopból a hozzá tartozó tételt beteszi a C oszlop megfelelő cellájába.
Azt hittem, hogy ez milyen egyszerű de nem. Az eredmény a képen.
Mit szúrok el? -
#11206
m.zmrzlina
senior tag
Delila_1
#11205
m.zmrzlina
senior tag
válasz
Delila_1
#11205
üzenetére
Arra gondolok, hogy pl az 123AC-ből az 123 az szám az AC meg mondjuk benne van a listában de így együtt nem érvényesíti mert az egész együtt se nem szám és az 123AC mint karaktersorozat nincs is a listában.
Szerk:
Ok igazad van, ha szóköz van a szám meg a betű közt akkor engedi -
#11204
m.zmrzlina
senior tag
m.zmrzlina
#11202
m.zmrzlina
senior tag
válasz
m.zmrzlina
#11202
üzenetére
Mondjuk nem tudom, hogy számok és betűk vegyesen előfordulhatnak-e egy cellában mert azt biztosan nem engedi a képlet és akkor bukott a megoldás.
-
#11202
m.zmrzlina
senior tag
Delila_1
#11201
-
#11199
m.zmrzlina
senior tag
pitman
#11198
m.zmrzlina
senior tag
válasz
pitman
#11198
üzenetére
Én úgy adnám meg a feltételt adatérvényesítésben, hogy a "Megengedve" opciónál nem a "Lista"-t választanám ki hanem az "Egyéni"-t
Itt képlettel a következőképpen adhatod meg, hogy mit fogadsz el bevitelként:
=VAGY(SZÁM(I1);SZÁM(HOL.VAN(I1;$M$6:$M$11;0)))
A fenti képlet I1-be számot és olyan karaktersorozatot enged ami az M6:M11 tartományban benne van. Ugyanis a HOL.VAN() #HIÁNYZIK-ot (hibát és nem számot) ad vissza ha a keresési érték nem szerepel a táblázatban.
Ha a SZÁM() és a HOL.VAN()első argumentuma relatív hivatkozással van megadva (pl I1) akkor nyugodtan másolhatod az adatérvényesítést az összes érintett celládba, működni fog.
-
#11144
m.zmrzlina
senior tag
Varga Csaba
#11142
m.zmrzlina
senior tag
válasz
Varga Csaba
#11142
üzenetére
Itt egy link ahol jó segítség található ahhoz, hogy meghatározd vajon milyen is a védelem valójában.
Ha szerencséd van akkor egy sima lapvédelemről van szó és akkor tudsz VBA kódot illeszteni a munkafüzetbe. Ez egy kipróbált kód, nekem eddig mindig működött ha sima jelszavas lapvédelmet kellett feloldani.
-
#11130
m.zmrzlina
senior tag
akos_1
#11129
m.zmrzlina
senior tag
válasz
akos_1
#11129
üzenetére
Én így keresnék legkisebb értéket:
Sub kikeres()
Dim legkisebb As Double
Dim hely_sora As Double, hely_oszlopa As Double
Dim cella As Range
legkisebb = ActiveCell.Value
For Each cella In Selection.Cells
If cella.Value < legkisebb Then
legkisebb = cella.Value
hely_sora = cella.Row
hely_oszlopa = cella.Column
End If
Next
Cells(hely_sora, hely_oszlopa).Interior.ColorIndex = 3
End SubMivel változik a tartomány én a felhasználóra bíznám a kijelölést (ha meg lehet oldani). A makrót a kijelölés elvégzése után kell indítani.
Ha nem megoldható, hogy a felhasználó jelöljön ki akkor megoldható makróból is de jobban írd körül, hogy mi alapján kell a kijelölést elvégezni!
-
#11128
m.zmrzlina
senior tag
zoli1962
#11119
m.zmrzlina
senior tag
válasz
zoli1962
#11119
üzenetére
Ilyen logika mentén is el lehet indulni:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Or Target.Column = 8 Then
Range("A" & ActiveCell.Row).Select
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Save
End If
End SubHa vagy a D vagy a H oszlopban változik valami akkor a változtatott cella sorának és az A oszlop metszéspontjában lévő cella tartalmát értékként magára másolja.
Ez az A oszlop megfelelő cellájából kitörli a benne lévő képletet így az a cella többet nem fog újraszámolódni.
-
#11127
m.zmrzlina
senior tag
zoli1962
#11124
m.zmrzlina
senior tag
válasz
zoli1962
#11124
üzenetére
Vess egy pillantást Kornl23 #10954-es hsz-ban lévő kérdésre és a rá adott válaszra. Ha az a módszer jó neked akkor tudjuk pontosítani és a te munkafüzetedhez illeszteni a makrót.
-
#11077
m.zmrzlina
senior tag
m.zmrzlina
#11076
m.zmrzlina
senior tag
válasz
m.zmrzlina
#11076
üzenetére
Na jó (Mea maxima culpa) az első kérdés fölösleges volt.
Hiába az a k...va diklekszia
-
#11076
m.zmrzlina
senior tag
TNT
#11074
m.zmrzlina
senior tag
Két kérdés.
1. A főtábla és a segédtábla egy munkafüzet két különböző munkalapja, vagy két külön fájl? Gyanítom a második.
2. találatkor a főtábla adott mezőjét a Ez azt jelenti, hogy azt a cellát kell átírni a segédtábla adott sor, B oszlop elemére amiben a találat volt? Tehát, hogy még érthetőbb legyen (vagy még zavarosabb) Ha a főtábla A5-ben megtalálom a melléktábla A5 értékét akkor a főtábla A5 felveszi a melléktábla B5 értékét?
-
#10970
m.zmrzlina
senior tag
medvezsolt
#10966
m.zmrzlina
senior tag
válasz
medvezsolt
#10966
üzenetére
Lehet és én ezt saját függvénnyel oldanám meg:
Function SZINESÖSSZEG2(minta As Range, tartomany As Range)
Dim cella As Range, osszeg As Double
szin = minta.Interior.ColorIndex
osszeg = 0
For Each cella In tartomany
If cella.Interior.ColorIndex = szin Then
osszeg = osszeg + cella.Value
End If
Next cella
SZINESÖSSZEG2 = osszeg
End FunctionGyakorlatilag ugyanaz mint itt csak pepitában. Ez a függvény a mintacella háttérszíne alapján összegez, nem pedig a betűszíne alapján.
-
#10967
m.zmrzlina
senior tag
medvezsolt
#10965
m.zmrzlina
senior tag
válasz
medvezsolt
#10965
üzenetére
Volt valami hasonló téma itt. Nem tudom jó-e neked csak rémlett hogy volt már szó ilyesmiről.
-
#10960
m.zmrzlina
senior tag
m.zmrzlina
#10959
m.zmrzlina
senior tag
válasz
m.zmrzlina
#10959
üzenetére
Mondjuk talán okosabb lenne a BeforeClose helyett a BeforeSave eseményt használni mert az BeforeClose-zal nem tudsz mentés nélkül kilépni a munkafüzetből (ha netán szükség lenne rá).
-
#10959
m.zmrzlina
senior tag
Kornl23
#10957
m.zmrzlina
senior tag
válasz
Kornl23
#10957
üzenetére
Továbbra is a MA() fv-ből indulnék ki.
Az előző megoldásomat egészítsd ki ezzel:Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Range("E1").Select
For i = 1 To Range("E" & Rows.Count).End(xlUp).Row
If ActiveCell.Value <> "" Then
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
ActiveCell.Offset(1, 0).Select
Next
ActiveWorkbook.save
Application.ScreenUpdating = True
End SubEz a megoldás a munkafüzet bezárása előtt a dátumokat tartalmazó cellákat felülírja a saját értékükkel, kitörölve egyúttal belőlük a MA() fv-t.
Ezt nem modulba kell másolni, hanem a ThisWorkbook BeforeClose eseményébe! Természetesen a te tartományaid nyilván mások.
-
#10956
m.zmrzlina
senior tag
Kornl23
#10954
-
#10935
m.zmrzlina
senior tag
Delila_1
#10934
-
#10933
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Ezt így értem, csak nekem itt a harmadik sorban az idézőjelek közt kellene használnom.
-
#10924
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Van több munkalapom amin több tartomány van elszórtan amibe feltételes formázást szeretnék tenni. A munkalap mindig más és más (a tartományok sem mindig ugyanott vannak és nem mindig ugyanakkorák)
Ilyen formázást szeretnék tenni bele(makrorögzítővel készítettem):
Range("A27:C29").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ÉRTÉK(BAL($B27;8))>=$F$24"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = FalseA tartományok határait meg tudom határozni makróval (Range(<akármi>).Select azonban az "=ÉRTÉK(BAL($B27;8))>=$F$24" sorban van egy változó (a példában a $B27) ami természetesen minden tartomány esetében más.
Gondolom a két idézőjel közé nem tehetek változót oda csak a konkrét cellahivatkozást lehet karakterről karakterre beírni.
Hogyan lehet ezt a problémát megoldani?
Csak találgatok: működhet-e az a megoldás, hogy összeállítom a teljes képletet egy sztring változóban és a változót írom a Formula1:= után idézőjelek nélkül?
-
#10897
m.zmrzlina
senior tag
cousin333
#10896
m.zmrzlina
senior tag
válasz
cousin333
#10896
üzenetére
...hogy a bemenő változókkal egyesével feltöltök egy-egy tömböt, az eredményeket kiszámolom egy másik tömbbe, majd egyesével kiírogatom őket a megfelelő helyekre...
Amit nekem sikerült kiérteni a vonatkozó forrásokból az az, hogy a szóban forgó módszert pont azért érdemes használni mert nem visz el rengeted időt az egyenkénti olvasás-írás. Gyakorlatilag az Excel "fejben" számolja az eredményt és egyszerre írja vissza a munkalapra.
A futásidő különbség nálam egy másik tartománynál (kb 8000 cella és mindegyikben WorksheetFunction-os szövegmanipuláció): cellánkénti módszernél 70mp körül, a "fejbenszámolós" módszer 1mp alatt
...(akár a
Sheets("újhely").Range("A11:H11").Value = Range("A23:H23").Value
módszerrel) átmásolod az új helyre....
Gyakorlatilag ez a módszer volt amit először javasoltam, de ez több ezer cellánál már időigényesebb a "tömbös" mószernél.
-
#10891
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Szerettem volna Pale (#10873)-ban leírt problémáját mintegy a magam okulására egy másik megközelítésből megoldani.
Már többször használtam azt a módszert, hogy (főleg nagyobb tartományoknál) nem cellánként olvasok és írok hanem egyben egy egész tartományt olvasok be, elvégzem a műveletet és egyben írom vissza a munkalapra az eredményt. Innen vettem az ötletet
Eddig még sosem volt olyan helyzet, hogy az eredmény tartomány méretét ne tudtam volna előre, hanem menet közben kelljen meghatározni.A következő kódot sikerült kiagyalni, és nem tudom, hogy (noha úgy tűnik működik) valójában így kell-e csinálni ezt vagy van-e erre valami bevett profi megoldás. Minden építő kritikát szivesen veszek.
Sub atmasol()
Dim bemenoadat() As Variant, eredmeny() As Variant
Dim i As Long, j As Integer, belistahossz As Long, kilistahossz As Long, m As Long
belistahossz = Cells(Rows.Count, 1).End(xlUp).Row
bemenoadat = Range("A1:H" & belistahossz).Value
kilistahossz = Application.WorksheetFunction.CountA(Range(Cells(1, 1), Cells(belistahossz, 1)))
m = 1
ReDim Preserve eredmeny(1 To kilistahossz, 1 To 8)
For i = 1 To belistahossz
If bemenoadat(i, 8) <> "" Then
For j = 1 To 8
eredmeny(m, j) = bemenoadat(i, j)
Next j
m = m + 1
End If
Next i
Worksheets("Munka2").Range("A1:H" & kilistahossz).Value = eredmeny
End Sub -
#10877
m.zmrzlina
senior tag
Pale
#10873
m.zmrzlina
senior tag
A létező legprimitívebb megoldás és ha valóban bolondbiztossá kell tenni akkor sok dolog lesz még vele de kiindulásnak talán jó:
Sub atmasol()
Dim sor As Integer
sor = 1
Worksheets("Munka1").Select
Do Until IsEmpty(Cells(sor, 1).Offset(1, 0)) = True
If Cells(sor, 8) <> "" Then
Range(Cells(sor, 1), Cells(sor, 8)).Copy Worksheets("Munka2").Range("A" & Worksheets("Munka2").Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
sor = sor + 1
Loop
End SubMunka1-en vannak a kiinduló adatok és Munka2-re teszi az eredményt, illetve azt feltételeztem, hogy az A oszlopban a lista aljáig egyetlen cella sem üres. Valamint a H oszlop üres celláiban <szóköz> sem lehet.
-
#10860
m.zmrzlina
senior tag
dellfanboy
#10855
m.zmrzlina
senior tag
válasz
dellfanboy
#10855
üzenetére
Nekem az A1:B4000-ben vannak a változópárok amiket el kell osztani egymással, az eredmény pedig az F1:F50 tartományba illetve attól jobbra kerül.
Sub lepopulal()
Dim bemenoadat As Variant
Dim eredmeny As Variant
Dim i As Integer
bemenoadat = Range("A1:B4000").Value
eredmeny = Range("F1:EXA1").Value
For i = 1 To 4000
eredmeny(1, i) = bemenoadat(i, 1) / bemenoadat(i, 2)
Next i
Range("F1:EXA50") = eredmeny
End Sub -
#10858
m.zmrzlina
senior tag
dellfanboy
#10855
m.zmrzlina
senior tag
válasz
dellfanboy
#10855
üzenetére
Hol kell keresni a változókat és hová kell tenni az eredményt?
-
#10834
m.zmrzlina
senior tag
Fire/SOUL/CD
#10833
m.zmrzlina
senior tag
válasz
Fire/SOUL/CD
#10833
üzenetére
Ilyet olvastam a Súgóban:
A nonvolatile function is recalculated only when the input variables change
Nem lehet hogy az autofilter-rel ellátott tartománynak a fejléce nem számít bemenő változónak?
Mert ha ezt a kérdéses fv-t amivel kapcsolatban ittérdeklődtem =FilterOn(A1) helyett =FilterOn(A2)-ként akarom használni akkor Volatile nélkül is működik.
És ez megmagyarázza, hogy miért működik csont nélkül a feltételes formázásnál
???
-
#10831
m.zmrzlina
senior tag
Fire/SOUL/CD
#10829
m.zmrzlina
senior tag
válasz
Fire/SOUL/CD
#10829
üzenetére
Jó de ebből hogyan derül ki, hogy melyik oszlop adatai alapján van szűrve a tartomány?
Az eredeti kérdésben ti. ez volt. -
#10830
m.zmrzlina
senior tag
Delila_1
#10828
m.zmrzlina
senior tag
válasz
Delila_1
#10828
üzenetére
Ha kiegészítem ezzel a sorral:
Application.Volatile
akkor úgy tűnik működik.
Innen szedtem.Valójában egyetlen sorát sem értem ennek a függvénynek (na jó az elsőt és az utolsót igen
.), de ilyen egymásba ágyazott With..End With szerkezetet nem láttam soha 
-
#10827
m.zmrzlina
senior tag
Delila_1
#10825
m.zmrzlina
senior tag
válasz
Delila_1
#10825
üzenetére
Maga a fv által visszaadott érték nálam valamiért így sem frissül. K1-be tettem ezt: =FilterOn(A1) és ha nincs szűrő az a oszlopban akkor HAMIS-t ad vissza. Azt várnám ha bekapcsolok egy szűrőt A1-ben akkor IGAZ-ra vált K1 értéke. Ez nem történik meg (az üres makróval sem) viszont ha bekapcsolt szűrőnél viszem be A1-re a FilterOn()-t akkor helyesen TRUE-t ad vissza.
Viszont ennek ellenére a felt. formázás jól működik
-
#10826
m.zmrzlina
senior tag
m.zmrzlina
#10824
m.zmrzlina
senior tag
válasz
m.zmrzlina
#10824
üzenetére
Ez működik!
Ezt a fv-t másold modulba:
Function FilterOn(myCell As Range) As Boolean
On Error Resume Next
With myCell.Parent.AutoFilter
With .Filters(myCell.Column - .Range.Column + 1)
If .On Then FilterOn = True
End With
End With
End Functionmajd formázd feltételesen a következőképpen:
A formázás érvényessége a példa munkalapon =$A:$G
-
#10824
m.zmrzlina
senior tag
Delila_1
#10823
-
#10815
m.zmrzlina
senior tag
Pityke78
#10813
-
#10803
m.zmrzlina
senior tag
djzomby
#10788
m.zmrzlina
senior tag
válasz
djzomby
#10788
üzenetére
Na tudtam, hogy egyszerűbben is lehet ezt.
Másold új modulba a következőt:
Function SZINESÖSSZEG(minta As Range, tartomany As Range)
Dim cella As Range, osszeg As Double
szin = minta.Font.Color
For Each cella In tartomany
If cella.Font.Color = szin Then
osszeg = osszeg + cella.Value
End If
Next cella
SZINESÖSSZEG = osszeg
End FunctionLegjobb ha a personal.xls (personal.xlsb) -be teszed mert akkor minden megnyitott munkafüzetben rendelkezésre fog állni egy SZINESÖSSZEG() nevű új függvény. Úgy használod mint a SZUM() fv-t csak ennek az első paramétere egy olyan abszolút cellahivatkozás (pl: $A$1) amiben ugyanolyan színű karakterek vannak mint amit össze akarsz adni.
Hogy érthetőbb legyen itt egy kép:
Köszönet az ötletért (ki másnak mint) Delila_1-nek
-
#10802
m.zmrzlina
senior tag
superecneB
#10801
m.zmrzlina
senior tag
válasz
superecneB
#10801
üzenetére
Válasz ment privátban.
-
#10800
m.zmrzlina
senior tag
superecneB
#10799
m.zmrzlina
senior tag
válasz
superecneB
#10799
üzenetére
Erre a kérdésre Delila_1 egyszer már itt válaszolt.
Csak akkor más tette fel a kérdést
-
#10797
m.zmrzlina
senior tag
djzomby
#10788
m.zmrzlina
senior tag
válasz
djzomby
#10788
üzenetére
Ilyen kicsi és jól körülhatárolt tartományoknál talán még nem fájóan amatőr megoldás számlálós ciklusra bízni a dolgot:
Sub szinösszeg_v2()
Dim pirososszeg As Single, feketeosszeg As Single
Dim i As Integer, j As Integer, betuszine As Integer
Cells(1, 1).Select
For i = 1 To 10
pirososszeg = 0
feketeosszeg = 0
For j = 1 To 6
betuszine = ActiveCell.Font.ColorIndex
Select Case betuszine 'ha a szöveg színe piros
Case Is = 3 'pirososszeghez aktív cella értékét hozzáadja
pirososszeg = ActiveCell.Value + pirososszeg
Case Is = 1 ''ha a szöveg színe fekete
feketeosszeg = ActiveCell.Value + feketeosszeg 'feketeoszeghez aktív cella értékét hozzáadja
End Select
ActiveCell.Offset(0, 1).Select 'következő cella
Next j
With Range("H" & i) ' sor végére G oszlopba
.Font.ColorIndex = 3 'pirossal
.Value = pirososszeg 'pirososszeget kiír
End With
With Range("G" & i) ' sor végére H oszlopba
.Font.ColorIndex = 1 'feketével
.Value = feketeosszeg 'feketeosszeget kiír
End With
ActiveCell.Offset(1, -6).Select 'vissza a sor elejére
Next i
End SubHa a tartomány változó akkor kötelező, ha a mérete jelentősen megnő akkor érdemes újragondolni a koncepciót.
-
#10787
m.zmrzlina
senior tag
djzomby
#10786
m.zmrzlina
senior tag
válasz
djzomby
#10786
üzenetére
Van egy szörnyű gyanúm, hogy van erre egyszerűbb megoldás is de több időm erre csak este lesz. Ha addig nem kapsz valami egyszerűbb megoldást akkor használd ezt:
Sub szinosszeg()
Range("A1").Select
Dim pirososszeg As Integer, feketeosszeg As Integer
Dim betuszine As Integer
pirososszeg = 0
feketeosszeg = 0
Do Until ActiveCell.Value = ""
betuszine = ActiveCell.Font.ColorIndex
Select Case betuszine
Case Is = 3
pirososszeg = ActiveCell.Value + pirososszeg
Case Is = 1
feketeosszeg = ActiveCell.Value + feketeosszeg
End Select
ActiveCell.Offset(1, 0).Select
Loop
Range("H2").Value = pirososszeg
Range("G2").Value = feketeosszeg
End Sub -
#10765
m.zmrzlina
senior tag
djzomby
#10761
m.zmrzlina
senior tag
válasz
djzomby
#10761
üzenetére
Nem tudom honnantól kell elmagyarázni a dolgot (és milyen Excel verziót használsz) de ha jól értem több színű szöveged van és attól függően, hogy milyen színű a szöveged kell különböző dolgokat csinálnia az Excelnek.
Az alábbi makró azt csinálja, hogy I3-tól végigmegy addig amíg van valami az oszlopban és a cella mellé írja a cella szövegének színkódját.
VB-be beilleszteni Insert>Modul menüből lehet
Sub szovegszin()
Range("I3").Select
Dim betuszine As Integer
Do Until ActiveCell.Value = ""
betuszine = ActiveCell.Font.ColorIndex
Select Case betuszine
Case Is = 3 'itt adod meg a szín kódjával, hogy milyen színű szöveg esetén...
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine 'itt adod meg, hogy mi történjen
Case Is = 4
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 5
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 6
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 7
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
Case Is = 8
ActiveCell.Offset(0, 1).Value = "A szomszédos cella betűszín kódja:" & betuszine
End Select
ActiveCell.Offset(1, 0).Select
Loop
End SubA Case Is sorban adod meg hogy milyen szín esetén, a következő sorban pedig hogy mit csináljon a program.
Színekről bővebb információ itt.
Jó lenne több részletet tudni a feladatról mert így csak vaktában lövöldözünk.
Még véletlenül eltaláljuk egymást -
#10758
m.zmrzlina
senior tag
perfag
#10757
m.zmrzlina
senior tag
válasz
perfag
#10757
üzenetére
"Néha a törpöm tele a Microsofttal, miért nem lehet ezt a Súgóban rendesen megtalálni."
Ehhez képest hányszor olvasom itt a fórumon, hogy a "Súgó a barátod"
Ilyenkor azt kívánom, hogy aki ilyet ír annak soha ne legyen jobb barátja mint az Excel Súgó!
![;]](//cdn.rios.hu/dl/s/v1.gif)
Volt ez már egyszer téma, valahol itt kezdődött.
-
#10749
m.zmrzlina
senior tag
Penge_4
#10745
m.zmrzlina
senior tag
-
#10726
m.zmrzlina
senior tag
cortez25
#10723
m.zmrzlina
senior tag
válasz
cortez25
#10723
üzenetére
Így már értem! A nálam ugyanis kulcsszavak voltak a megértéshez
Nekem innen ez már makró, mégpedig a következő formában.
Ez a táblázat:
Ez a hozzá tartozó makró:
Sub megkeres()
For i = 2 To Range("J2").End(xlDown).Row
For Each cell In Selection.Cells
If Range("J" & i).Value = cell.Value Then
Range("J" & i).Offset(0, 1).Value = "OK"
Exit For
Else
Range("J" & i).Offset(0, 1).Value = "NOK"
End If
Next cell
Next i
End SubTermészetesen ezt is adoptálnod kell a saját tartományaidhoz, valamint a makrót úgy indítod, hogy kijelölöd a teljes tartományt amiben keresni szeretnéd a neveket.
-
#10722
m.zmrzlina
senior tag
cortez25
#10721
m.zmrzlina
senior tag
válasz
cortez25
#10721
üzenetére
Biztosan mindketten erről a táblázatról beszélünk?
-
#10717
m.zmrzlina
senior tag
cortez25
#10715
-
#10662
m.zmrzlina
senior tag
sz.j
#10661
m.zmrzlina
senior tag
Ugyanúgy mint Excelben.
Insert (sor vagy oszlop ami kell) aztán Copy>Paste special, és kiválasztod, hogy mit akarsz beilleszteni.
Szerk:
Arra azért figyelj, hogy jónéhány Excel függvény nem működik OO-ban.
-
#10649
m.zmrzlina
senior tag
VANESSZA1
#10648
m.zmrzlina
senior tag
válasz
VANESSZA1
#10648
üzenetére
Igen lehet. Excel 2007-nél legalábbis:
Mentéskor az Eszközök>Beállítások menüben tudod megadni a jelszót.
Ha megadtad a jelszót fogja kérni még egyszer.
Többet itt tudhatsz meg:
http://spreadsheetpage.com/index.php/tip/spreadsheet_protection_faq1/ -
#10640
m.zmrzlina
senior tag
perfag
#10639
m.zmrzlina
senior tag
válasz
perfag
#10639
üzenetére
Azért mert szerintem jogos igény, hogy egymás alatt szeretné látni a karbantartandókat. Ezzel a módszerrel minden alkatrésznek kellene lenni a főoldalon egy sorának amiben az érték megfelelően HA()függvényezve vagy látszik vagy nem. De ha az első 15 alkatrész nem vár karbantartásra akkor csak a 16.sorban lesz valami. Tudom le lehet szűrni meg minden de szerintem is egyszerűbb itt egy makró csak ahhoz látni kéne a fájlt.
Én nem szórom úgy a makrókat mint Delila_1, hogy ha kell fél óra alatt tízet összehoz ha nem olyan az igény ahogy ő a probléma leírása alapján gondolja.
-
#10609
m.zmrzlina
senior tag
ArchElf
#10608
-
#10606
m.zmrzlina
senior tag
medvezsolt
#10605
m.zmrzlina
senior tag
válasz
medvezsolt
#10605
üzenetére
Szivesen.
-
#10600
m.zmrzlina
senior tag
Delila_1
#10599
m.zmrzlina
senior tag
válasz
Delila_1
#10599
üzenetére
Így bizony.
Erre a te színlekérdezős makród is azt válaszolja (akármilyen színe van a háttérnek) hogy átlátszó.
És gondolom az Interior.Colorindex miatt a visszaadott színek az 56-os számozás szerint adódnak vissza.
-
#10598
m.zmrzlina
senior tag
Delila_1
#10597
m.zmrzlina
senior tag
válasz
Delila_1
#10597
üzenetére
Állíts egy cellát alapban arra a színre, amit majd a feltétellel akarsz létrehozni, és ezt kérdezd le.
Ezzel a módszerrel kérdés nélkül is le tudnám kérdezni.
Az "alapban arra a színre állítás"-sal van gondom (ezt nem tudom másolni sem irányított beillesztéssel sem formátum másoló ecsettel)
-
#10596
m.zmrzlina
senior tag
Delila_1
#10594
m.zmrzlina
senior tag
válasz
Delila_1
#10594
üzenetére
Ahogy a formátumfestővel úgy az irányított beillesztéssel is tudom másolni. (ti ha a formátum másolása után kitöltöm adattal a cellákat) Én azt reméltem, hogy a feltételesen formázott celláknak csak a színét le tudom másolni üres cellákba.
De ez nem is nyomaszt annyira engem mint az Immediate ablakos lekérdezés. Ott ha üres a cella ha van benne adat mindig a fehér cella háttérszínét adja a ?ActiveCell.Interior.Color parancs.
-
#10591
m.zmrzlina
senior tag
Pá
#10589
m.zmrzlina
senior tag
Szerintem ebből makró lesz de ezzel kapcsolatban nekem is van kérdésem.
Miért nem lehet egy feltételesen formázott cella háttérszínét Másolás>Irányított beillesztés>Formátum módszerrel lemásolni?
Illetve ha ilyen cella háttérszínének az értékét szeretném lekérdezni az Immediate ablakban az ?ActiveCell.Interior.Color paranccsal akkor a fehér (vagy Nincs kitöltés) értékét adja ( 16777215-öt)?
(Ismerjük a viccet? "Angolórát adok-veszek.")
-
#10590
m.zmrzlina
senior tag
Pá
#10589
m.zmrzlina
senior tag
Egy form-ot szeretnék csinálni, amibe mindig becopyzok egy oszlopnyi adatot és mindig az aktuális adatok határozzák meg a tartományt.
Így már értem, valóban nem a szín a probléma gyökere. A "form" gondolom nem VBA UserForm hanem egy megfelelően kialakított Excel munkalap, ugye?
-
#10588
m.zmrzlina
senior tag
Pá
#10587
m.zmrzlina
senior tag
Ez sajnos nem jó nekem. Én ezzel a módszerrel szeretném megoldani, ha lehet, csak a cellák helyett a betűket színezze.
De bizony, hogy jó.
Csak a példámban egy szín világosság értéke változik neked pedig az kell, hogy (ha nem is silány 5 lépésben) két szín átmenjen egyikből a másikba. Sajnos ha ragaszkodsz a példádban lévő látványhoz akkor nem fogod megúszni az egyéni színek felvételét. Minél finomabb átmeneteket akarsz annál többet.A 2007-es Excel alapból nem tudja (vagy legalábbis én nem tudok róla) azt a formázást amit szeretnél, szóval kénytelen leszel szegelgetni.
Mi a tartomány (legkiseb-legnagyob szám) amit kezelni szeretnél. Lehet nekiállok egy kicsit művészkedni. (Jelzem botrányos színlátásom van
) -
#10586
m.zmrzlina
senior tag
medvezsolt
#10584
m.zmrzlina
senior tag
válasz
medvezsolt
#10584
üzenetére
Nyisd meg a kérdéses munkafüzetet és új modulba másold be ezt majd futtasd:
Sub PasswordBreaker()
'
' Published by Jacob 'm3Rlin' Dybala (www.m3Rlin.org)
' Original post: http://www.m3rlin.org/wordpress/excel-worksheet-protection-code-breaker
' Feel free to visit and write a comment!
'
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
ActiveWorkbook.Sheets(1).Select
Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next:
Next: Next: Next
Next: Next: Next:
Next: Next: Next
End Sub -
#10582
m.zmrzlina
senior tag
Pá
#10580
m.zmrzlina
senior tag
Az első kérdésedre:
A tartományt (a legkisebb és a legnagyobb szám közötti tartományt ) felosztod annyi részre ahány szintű átmenetet akarsz csinálni. Minél több a szint annál finomabb lesz az átmenet. Az 5 célszerűnek látszik mert ahhoz nem kell egyéni szinekkel bajlódni csak kiválasztani a "Téma szinei"-ből.
Aztán minden szinthez csinálsz Feltételes formázást az alábbiak szerint:
Az intervallumok határait megadod a "következők között van" utáni két cellában, és a Betűtipus fülön kiválasztasz az adott intervallumhoz egy betűszínt. Célszerűnek látszik a legvilágosabbal kezdeni és minél nagyobbak a számok annál sötétebb színt választani.
A végén a szabálykezelőben ilyesmit kell látnod:
aminek mindegy, hogy a 
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
Hirdetés
- E-roller topik
- Okos Otthon / Smart Home
- Formula-1
- A Micron újszerű módszerrel javítja QLC-s SSD-jének sebességét
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- VR topik
- Apple iPhone 16 Pro - rutinvizsga
- Magga: PLEX: multimédia az egész lakásban
- alza vélemények - tapasztalatok
- Milyen videókártyát?
- További aktív témák...
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Antivírus szoftverek, VPN
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- Csere-Beszámítás! Akciós Gamer PC! R5 5500 / GTX 1070Ti Rog Strix / 32GB D4 / 500GB SSD
- 18 éve! Billentyűzet magyarítás magyarosítás. Festés vagy lézerezés és egyebek! 3 lehetőség is van.
- Csere-Beszámítás! Olcsó Számítógép PC Játékra! R5 1500X / RX 570 8GB / 16GB DDR4 / 250SSD + 2TB HDD
- Apple iPhone 13 Pro 128GB, Kártyafüggetlen, 1 Év Garanciával
- Apple iPhone 13 . 128GB , Kártyafüggetlen , 100% akku
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest