-
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
f(x)=exp(x)
#48443
üzenetére
-
Delila_1
veterán
válasz
Lasersailing
#48382
üzenetére
Jelentkezz, mindig lesz itt valaki, aki segít.
-
Delila_1
veterán
válasz
Lasersailing
#48380
üzenetére
Egyszerűbb, ha ComboBoxot viszel a formra. A RowSource tulajdonságnál megadod a választható tételek helyét, pl. Munka1!A1:A20
Ezután a ComboBox1 értékére hivatkozhatsz a
Private Sub ComboBox1_Change()makróban. -
Delila_1
veterán
válasz
Darth_Revan
#48275
üzenetére
Egy kis makró:
Sub Csere_0_1()Dim sor As Long, oszlop As Integersor = 1Do While Cells(sor, "A") > ""oszlop = Cells(sor, Columns.Count).End(xlToLeft).ColumnIf Application.WorksheetFunction.CountIf(Range(Cells(sor, 1), Cells(sor, oszlop)), "kettő") > 0 ThenRange(Cells(sor, 1), Cells(sor, oszlop)) = 1ElseRange(Cells(sor, 1), Cells(sor, oszlop)) = 0End Ifsor = sor + 1LoopEnd Sub
-
Delila_1
veterán
válasz
zsoci0914
#48179
üzenetére
Szóval érvényesítést alkalmazol, és az adott sor valamelyik cellájába kell beírni a dátumot.
A makrót a laphoz kell rendelned, és majd makróbarátként kell mentened a füzetet.
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Column = 1 ThenApplication.EnableEvents = FalseSelect Case Target.ValueCase "Beérkezve": Cells(Target.Row, "M") = Format(Now, "yyyy.mm.dd hh:mm:ss")Case "Gyártás alatt": Cells(Target.Row, "N") = Format(Now, "yyyy.mm.dd hh:mm:ss")Case "Kész": Cells(Target.Row, "O") = Format(Now, "yyyy.mm.dd hh:mm:ss")Case "Kiszállítva": Cells(Target.Row, "P") = Format(Now, "yyyy.mm.dd hh:mm:ss")End SelectApplication.EnableEvents = TrueEnd IfEnd Sub -
Delila_1
veterán
válasz
zsoci0914
#48176
üzenetére
Nem írtad, hogy mi adja a lehetőségeket. Érvényesítés, ComboBox a munkalapon, esetleg ComboBox Userformon. Azt sem írtad, melyik sorba kéred a dátumot és időt.
Találomra vettem azt az esetet, mikor a munkalapon van egy ComboBox, és az A oszlopban folyamatosan vannak adatok.
A laphoz rendeltem egy makrót, ami az első üres sorba írja ki a választásnak megfelelően a B, C, D, ill. az E oszlopba. A választási lehetőségek "B oszlopba dátum", "C oszlopba dátum", ...
Megeshet, hogy egészen másról van szó, akkor írd meg pontosan, mit szeretnél.Private Sub ComboBox1_Change()Dim usor As Longusor = Range("A" & Rows.Count).End(xlUp).Row + 1Select Case Left(ComboBox1, 1)Case "B": Cells(usor, 2) = Format(Now, "yyy.mm.dd hh:mm:ss")Case "C": Cells(usor, 3) = Format(Now, "yyy.mm.dd hh:mm:ss")Case "D": Cells(usor, 4) = Format(Now, "yyy.mm.dd hh:mm:ss")Case "E": Cells(usor, 5) = Format(Now, "yyy.mm.dd hh:mm:ss")End SelectEnd Sub -
-
Delila_1
veterán
válasz
KaliJoe
#48152
üzenetére
Még mindig nem teljes. Mi van akkor, ha nincs 0-nál nagyobb értékű 5 oszlopod?
Átalakítottam úgy, hogy soronként jó eredményt kapj.A Z2 cella képlete
=HAHIBA(MAX(HA(HOL.VAN(0;A2:X2;0)<6;INDIREKT("A" & SOR()&":" & CÍM(SOR();HOL.VAN(0;A2:X2;0)-1;4;1)); INDIREKT(CÍM(SOR();HOL.VAN(0;A2:X2;0)-1;4;1) & ":" & CÍM(SOR();HOL.VAN(0;A2:X2;0)-5;4;1))));MAX(A2:X2))
ezt másolhatod lefelé.
Akkor is működik, mikor csakis nulla értékek vannak egy-egy sorban.
Zöld hátteret adtam a sorokban a MAX aktuális tartományának. -
Delila_1
veterán
válasz
phanfantom
#48113
üzenetére
Feltöltöttem egy fájlt ide .
Akkor kell módosítani a makrón, ha a tartományod nem azA:Ftartományban van, vagy nem az F oszlop tartalmazza a lejárati dátumokat. -
Delila_1
veterán
válasz
phanfantom
#48111
üzenetére
És még 2 sort. Az egyikben lejárt tétel legyen, a másikban nem.
Pl. a képmetszővel készíthetsz egy fotót róla, és azt illeszted be ide. A képen az oszlopazonosítóknak (A, B, stb.) is látszaniuk kell. -
Delila_1
veterán
válasz
phanfantom
#48109
üzenetére
[link] Add meg ...
-
Delila_1
veterán
válasz
phanfantom
#48106
üzenetére
Tegyél fel egy képet, ami tartalmazza a címsort, és még 2 sort, amik közül az egyik lejárt, a másik nem. Ezek nélkül csak találgatni lehet, és utólag át kellene írnod egy halom értéket a makróban.
-
Delila_1
veterán
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Column = 1 ThenApplication.EnableEvents = FalseIf Application.WorksheetFunction.CountA(Range(Target.Address)) = Target.Count ThenRange(Target.Address).Offset(, 1) = DateElseRange(Target.Address).Offset(, 1) = ""End IfApplication.EnableEvents = TrueEnd IfEnd SubHa nem az első oszlopba írsz adatot, akkor az
If Target.Column = 1 Thensorban kell az 1-et átírnod az oszlop számára. Ha pedig a dátumot nem a következő oszlopba íratnád, akkor aRange(Target.Address).Offset(, 1) = ""sorban kell az 1-et annyira átírni, ahány oszloppal jobbra szeretnéd megkapni. -
Delila_1
veterán
válasz
Fire/SOUL/CD
#48099
üzenetére
"Ismerlek" annyira, hogy ne vegyem kekeckedésnek.
Nem valószínű, hogy egyetlen cellára gondolt a kérdező, mikor A1-et írt. Ha csupán 1-ről lenne szó, nem kérne segítséget, hanem Ctrl+0-val bevinné a dátumot.
A dátumot és az időt a síma Now is beviszi. Csak a formátumot kell helyesen megadni.Range("FIRE_RANGE").Offset(, 1) = Now -
Delila_1
veterán
válasz
Fire/SOUL/CD
#48096
üzenetére
Miért?
-
Delila_1
veterán
válasz
Fire/SOUL/CD
#48090
üzenetére
Kiküszöbölve.
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Count = 1 ThenIf Target.Column = 1 And Target > "" Then Cells(Target.Row, 2) = DateIf Target.Column = 1 And Target = "" Then Cells(Target.Row, 2) = ""End IfEnd Sub -
Delila_1
veterán
-
Delila_1
veterán
-
Delila_1
veterán
-
Delila_1
veterán
Vegyük, hogy a telefonok az A oszlopban vannak, A2-től lefelé. Ezek szövegesen vannak eltárolva.
A B2-ben ellenőrizzük a számok elejét.
=VAGY(BAL(A2;4)="0620";BAL(A2;4)="0630";BAL(A2;4)="0670";BAL(A2;5)="+3620")C2-ben vizsgáljuk a hosszat.
=VAGY(HOSSZ(A2)=11;ÉS(BAL(A2;1)="+";HOSSZ(A2)=12))Végül D2-ben írjuk ki az eredményt.
=HA(ÉS(B2;C2);"Jó";"Hibás") -
Delila_1
veterán
Nem értettem, hogy "csak az utolsot kilistanzi". Nem lehet 1 adatot kilistázni. Azt hiszem, arra gondolsz, hogy a 150 szavazat végrehajtása után jelenjen meg a 150 eredmény.
A mostani makró ezt az A oszlopba írja ki, majd a B1 cellába beírja az egyik választás darabszámát, a C1-be a másikét.Sub Szavazas()Dim x As Integer, veletlen As IntegerDim almaDb As Integer, korteDb As IntegerFor x = 1 To 150Randomize: Calculateveletlen = Application.WorksheetFunction.RandBetween(1, 2)Select Case veletlenCase 1: almaDb = almaDb + 1: Cells(x, 1) = "alma"Case 2: korteDb = korteDb + 1: Cells(x, 1) = "körte"End SelectNextCells(1, 2) = "alma " & almaDb & " db"Cells(1, 3) = "körte " & korteDb & " db"Columns("A:C").EntireColumn.AutoFitEnd Sub -
Delila_1
veterán
Ennek így nem sok értelmét látom. Ha csak az utolsó véletlent kell kiírni, az pontosan annyit ér, mintha csak egyszer szavaznál.
Írtam egy kis makrót arra, hogy 150 választás közül azt írja ki, amelyikre többen szavaztak.Sub Szavazas()Dim x As Integer, veletlen As IntegerDim almaDb As Integer, korteDb As IntegerFor x = 1 To 150Randomize: Calculateveletlen = Application.WorksheetFunction.RandBetween(1, 2)Select Case veletlenCase 1: almaDb = almaDb + 1Case 2: korteDb = korteDb + 1End SelectNextIf almaDb > korteDb ThenCells(1) = "alma = " & almaDb & " db"ElseCells(1) = "korte = " & korteDb & " db"End IfEnd Sub -
Delila_1
veterán
Nem írtad, melyik verziót használod. Azt hiszem, a 2016-os verziótól kezdve egyszerű a dolgod.
Az oszlopod melletti első cellába beírod a százalékot, majd a cellán állva Kezdőlap, Szerkesztés csoport, Kitöltés, Villámkitöltés. Ez minden alatta lévő cellába beírja a helyes eredményt. -
Delila_1
veterán
válasz
csferke
#47944
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)Dim lapnev As StringIf Target.Address = "$B$3" ThenApplication.EnableEvents = Falselapnev = "Állandó " & Range("L1")Sheets(lapnev).Name = "Állandó " & Range("B3")Range("L1") = Range("B3")Application.EnableEvents = TrueEnd IfEnd SubElső futtatás előtt írd be az L1-be az állandó szöveg utáni részt.
-
Delila_1
veterán
válasz
Fferi50
#47918
üzenetére
Ez csak azt mutatja, hogy tabulálással jól lehet láttatni az összetartozó egységeket. Hibakezeléssel:
If Range("A1") > 0 ThenGo To HibaElseRange("B1") = 20: Exit SubEnd IfHiba:MsgBox "..."On Error GoTo 0Egy rossz példa találomra erről a fórumról:Select Case CStr(freq)Case "4 weekly", "monthly"nyomtatni = TrueCase "2 monthly"nyomtatni = Month(nextmonth) Mod 2 = 1Case "3 monthly"nyomtatni = Month(nextmonth) Mod 3 = 1End Select -
Delila_1
veterán
válasz
Fferi50
#47916
üzenetére
Szerintem semmi gond a Go To utasítással. Az áttekinthetőséget a tabulátorok adják. Az ugrás címe mindig a 0 pozícióban van, az összes többi ettől jobbra.
Nagy időt a feltételek vizsgálata igényel ismereteim szerint.Az összetartozó részek is szépen látszanak egy normális tagolásnál.
If Range("A1") > 0 ThenRange("B1") = 10ElseRange("B1") = 20End If -
Delila_1
veterán
válasz
eszgé100
#47881
üzenetére
Gyorsíthatod a futást, ha nem állsz rá lépten-nyomon egyes cellákra. 5 ilyen feltételt láttam.
If CStr(dat) <> "" ThenSheets(ssheet).SelectRange(dat).SelectActiveCell.Formula = sDateEnd Ifhelyett írd ezt
If CStr(dat) <> "" Then Sheets(ssheet).Range(dat).Formula = sDate -
Delila_1
veterán
válasz
[CS]Blade2
#47801
üzenetére
Nálam is kétszer ki kellett javítani a felt. formázás tartományát, végül beletörődött.
-
Delila_1
veterán
válasz
[CS]Blade2
#47799
üzenetére
Írd vissza az eredeti tartományt a feltételes formázásnál, utána jó lesz.
-
Delila_1
veterán
válasz
[CS]Blade2
#47797
üzenetére
-
-
Delila_1
veterán
Feltöltöttem egy fájlt
A bal oldali táblázat bővítésekor a jobb oldali kimutatáson jobb klikk, frissítés. -
Delila_1
veterán
Teljes oszlophoz
Sub Nagy_Kicsi()Dim szoveg As String, sor As IntegerFor sor = 1 To 8Range("A" & sor).CopyRange("B" & sor).PasteSpecial xlPasteValuesszoveg = Range("B" & sor).ValueRange("B" & sor).Characters(Start:=1, Length:=InStr(szoveg, "(") - 1).Font.Size = 15Range("B" & sor).Characters(Start:=InStr(szoveg, "("), Length:=20).Font.Size = 8NextEnd Sub
-
Delila_1
veterán
Képletet tartalmazó cellában nem tudod a karakterek egy részét módosítani.
Lehet viszont segédcellában, ahova értékként átmásolod a képletet tartalmazó cella adatát. Ezt teszi a lenti makró. Az utolsó előtti sor a zárójel előtti részt 15-ös karakterűre állítja a segédcellában, az utolsó a többi részt 8-asra. Nem kívánt törlendő, a két méret tetszés szerint módosítható.
Ciklusba is beteheted, hogy egy teljes oszlop adatait átmásolja, és formázza.Sub Nagy_Kicsi()Dim szoveg As String, kezd As IntegerRange("A1").CopyRange("B1").PasteSpecial xlPasteValuesszoveg = Range("B1").Valuekezd = InStr(szoveg, "(")Range("B1").Characters(Start:=1, Length:=kezd - 1).Font.Size = 15Range("B1").Characters(Start:=kezd, Length:=20).Font.Size = 8End Sub -
Delila_1
veterán
válasz
ReSeTer
#47617
üzenetére
Betettem két soremelést az Else ágba, hogy feltünőbb legyen a sorszám.
Sub Talalat()Dim talalOn Error Resume NextColumns(2).ClearContents 'A későbbi beírás miatt törlöm a B oszlop adataittalal = Application.Match(Range("G1"), Columns(1), 0)If VarType(talal) = vbError ThenMsgBox "Nem található a G1 cella értéke az A oszlopban", vbInformation, "Hiányzó szöveg"On Error GoTo 0ElseMsgBox "G1 cella tartalmának sorszáma az A oszlopban: " & vbLf & vbLf & talal, vbInformation, "Sorszám"'Itt felhasználjuk a talal változó értékétRange("B" & talal) = "Ebben a sorban van a G1 cella értéke"End IfEnd Sub
-
Delila_1
veterán
válasz
ReSeTer
#47611
üzenetére
Sub Talalat()Dim talalOn Error Resume Nexttalal = Application.Match(Range("G1"), Columns(1), 0)If VarType(talal) = vbError ThenMsgBox "Nem található a G1 cella értéke az A oszlopban", vbInformation, "Hiányzó szöveg"ElseMsgBox "G1 cella tartalmának sorszáma az A oszlopban: " & talal, vbInformation, "Sorszám"End IfOn Error GoTo 0End Sub -
Delila_1
veterán
Felveszel egy segédoszlopot, ahol összefűzöd a előtte lévő oszlopok adatait.
=A2 & " " & B2 & " " & C2
Nálam 3 oszlop van, a negyedikbe kerül a képlet.
Kijelölöd az első három oszlopot, majd a felt. formázáshoz egyedi képletet viszel be.=DARABTELI($D$2:$D$35;$D2)>1
Persze nem 35-ig lesznek a sorok. -
Delila_1
veterán
A régi alá másolod az újat. Mindegyikben az A oszlopban vannak az azonosítók.
Kijelölöd az A oszlop sorait, majd a feltételes formázásnál a Csak az egyedi vagy ismétlődések formázása opciót választod, a Formázás minden-nél pedig az ismétlődőt jelölöd be.Szerk.: míg írtam, megjött a válaszod, hogy nem lehet bennük egyező azonosító.
-
Delila_1
veterán
Látom, régi verzióval (xls kiterjesztés) dolgozol.
Nálam a két füzet régi.xls, ill. új.xls névre hallgat, mindegyikben az első munkalapon vannak az adatok, és mindkettőben az első sor a fejléc.A makró:
Sub Frissites()Dim sorRegi As Long, sorUj As Long, usor As Long, ideusor = Workbooks("új.xls").Sheets(1).Range("A" & Rows.Count).End(xlUp).RowFor sorUj = 2 To usorOn Error Resume Nextide = Application.Match(Workbooks("új.xls").Sheets(1).Cells(sorUj, 1), Workbooks("régi.xls").Sheets(1).Columns(1), 0)If VarType(ide) = vbError Then _ide = Application.WorksheetFunction.CountA(Workbooks("régi.xls").Sheets(1).Columns(1)) + 1Workbooks("új.xls").Sheets(1).Rows(sorUj).Copy Workbooks("régi.xls").Sheets(1).Range("A" & ide)NextEnd Sub -
Delila_1
veterán
Lehet, hogy van egyszerűbb módja is, én ezt írtam:
Sub lapok()Dim kezd As Integer, lap As IntegerFor lap = 1 To Sheets.CountIf Sheets(lap).Name = "alma" Then kezd = lapIf Sheets(lap).Name = "körte" Then Exit ForNextMsgBox "Az alma és a körte nevű lapok között " & lap - kezd - 1 & " másik lap van.", vbInformation, "Tájékoztatás"End Sub -
Delila_1
veterán
Szia!
Addig nem fog sikerülni, míg az egyik adat szám, a másik szöveg.
Valahonnan úgy lett másolva, hogy a tizedes törtek szövegként, balra igazítva kerültek a fájlba. 2-3 ilyen cellát együttesen kijelölve lent a státusz sorban csak a cellák darabszáma jelenik meg, az összegük és átlaguk nem.
Írd be újra az adatokat, és akkor lappy képletével tudsz számolni.=DARABTELI(D2:D8;">=50")
Új hozzászólás Aktív témák
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Eladó Steam kulcsok kedvező áron!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- PC Game Pass előfizetés
- Játékkulcsok : ! Legjobb Áron ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok : (12.10.)
- Bomba ár! Dell Latitude 3500 - i5-8GEN I 8GB I 256SSD I HDMI I 15,6" FHD I Cam I W11 I Gar!
- Bomba ár! HP Probook 450 G10 - i3-1315U I 16GB I 256SSD I 15,6" FHD I W11 I Cam I Garancia!
- Surface Pro 7+ i5-1135G7 16GB 1000GB 1 év garancia
- Dell latitude, precision, xps, magyar világítós billentyűzetek eladóak
- Sound Blaster AE-7 (B-Stock)
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi







