-
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
andreas49
#48559
üzenetére
Másold be a makrót egy modulba az Összefoglaló szerint.
Sub Sorbeszuras()Dim sor As Long, usor As Long, lepeskoz As Integerlepeskoz = Application.InputBox("Hány üres sor legyen az adatok között?", "Üres sorok száma", , , , , , 1)usor = Range("A" & Rows.Count).End(xlUp).RowFor sor = usor To 3 Step -1Rows(sor & ":" & sor + lepeskoz - 1).Insert Shift:=xlDownNextEnd Sub -
#48508
Delila_1
veterán
Fire/SOUL/CD
#48501
Delila_1
veterán
válasz
Fire/SOUL/CD
#48501
üzenetére
Hihetetlen, mire nem vetemedsz!
-
Delila_1
veterán
válasz
Nixon18
#48495
üzenetére
Valamikor régen már feltettem a makrót – talán többször is – de most nem találom. Újra felteszem.
Function Szam_kiiras(szam As Long) As StringDim j1, j10, j10a, j100j1 = Array("", "egy", "kettő", "három", "négy", "öt", "hat", "hét", "nyolc", "kilenc")j10 = Array("", "tíz", "húsz", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")j10a = Array("", "tizen", "huszon", "harminc", "negyven", "ötven", "hatvan", "hetven", "nyolcvan", "kilencven")j100 = Array("száz", "", "ezer", "millió", "milliárd")betu = ""If szam = 0 ThenSzam_kiiras = "Nulla"Exit FunctionEnd Ifs = Format(szam, "0")j = 1While s <> ""i = Len(s) - 2If i < 1 Then i = 1s2 = Mid(s, i, 3)s = Left(s, i - 1)s3 = ""If Len(s2) = 3 Thens3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)If Mid(s2, 1, 1) <> "0" Then s3 = s3 + j100(0)s2 = Right(s2, Len(s2) - 1)End IfIf Len(s2) = 2 ThenIf Mid(s2, 2, 1) = "0" Thens3 = s3 + j10(Asc(Mid(s2, 1, 1)) - 48)Elses3 = s3 + j10a(Asc(Mid(s2, 1, 1)) - 48)End Ifs2 = Right(s2, Len(s2) - 1)End Ifs3 = s3 + j1(Asc(Mid(s2, 1, 1)) - 48)If s3 <> "" Then s3 = s3 + j100(j)If (betu <> "") And (szam > 2000) And (s3 <> "") Then kot = "-" Else kot = ""betu = s3 + kot + betuj = j + 1Wendbetu = UCase(Left(betu, 1)) & Right(betu, Len(betu) - 1)Szam_kiiras = betuEnd Function -
#48444
Delila_1
veterán
f(x)=exp(x)
#48443
Delila_1
veterán
válasz
f(x)=exp(x)
#48443
üzenetére
Szia!
Egy segédoszlopban összefűzöd az A és B oszlop nevét (egy köztes "_" karakterrel), majd erre keresel rá a másik táblában.
-
#48383
Delila_1
veterán
Lasersailing
#48382
Delila_1
veterán
válasz
Lasersailing
#48382
üzenetére
Jelentkezz, mindig lesz itt valaki, aki segít.
-
#48381
Delila_1
veterán
Lasersailing
#48380
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. -
#48288
Delila_1
veterán
Darth_Revan
#48275
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. -
#48114
Delila_1
veterán
phanfantom
#48113
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. -
#48112
Delila_1
veterán
phanfantom
#48111
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. -
#48110
Delila_1
veterán
phanfantom
#48109
Delila_1
veterán
válasz
phanfantom
#48109
üzenetére
[link] Add meg ...
-
#48107
Delila_1
veterán
phanfantom
#48106
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. -
#48100
Delila_1
veterán
Fire/SOUL/CD
#48099
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) = NowKellemes Karácsonyt!
-
#48098
Delila_1
veterán
Fire/SOUL/CD
#48096
Delila_1
veterán
válasz
Fire/SOUL/CD
#48096
üzenetére
Miért?
-
#48091
Delila_1
veterán
Fire/SOUL/CD
#48090
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 -
#47802
Delila_1
veterán
[CS]Blade2
#47801
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.
-
#47800
Delila_1
veterán
[CS]Blade2
#47799
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.
-
#47798
Delila_1
veterán
[CS]Blade2
#47797
Delila_1
veterán
válasz
[CS]Blade2
#47797
üzenetére
A feltételes formázás tartománya
A4:C...
Az I2:I15 tartomány neve Ünnepek, ide vittem be az év ünnepnapjait. -
-
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
Új hozzászólás Aktív témák
- Milyen TV tunert vegyek?
- Google Pixel topik
- Gyúrósok ide!
- TCL LCD és LED TV-k
- A '90-es évek jutnak az eszünkbe az ATK készülő egeréről
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Motoros topic
- Itt a Galaxy S26 széria: az Ultra fejlődött, a másik kettő alig
- Assetto Corsa EVO
- Ilyen olcsó sem volt még egy Apple notebook
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Fallout 4 Pip-Boy Edition eladó
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- 10+ db - Lenovo LOQ (15IRX10) - Intel Core i7-13650HX, RTX 5060
- GYÖNYÖRŰ iPhone SE 2020 64GB Red -1 ÉV GARANCIA - Kártyafüggetlen, MS4527, 100% Akksi
- Apple iPhone 6/6 Plus szerviz alkatrészek, készletről akár másnapra!
- Keresünk Galaxy S21/S21+/S21 Ultra/S21 FE
- AKCIÓ! Microsoft XBOX Series X 1TB SSD fekete játékkonzol garanciával hibátlan működéssel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest