- Netfone
- Körvonalazódnak a Xiaomi 16 specifikációi
- 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)
- 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?
-
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
-
#11635
Delila_1
veterán
m.zmrzlina
#11633
Delila_1
veterán
válasz
m.zmrzlina
#11633
üzenetére
Ennek tényleg örülök, és gratulálok!
-
#11610
Delila_1
veterán
m.zmrzlina
#11609
Delila_1
veterán
válasz
m.zmrzlina
#11609
üzenetére
Igen.
-
#11608
Delila_1
veterán
m.zmrzlina
#11607
Delila_1
veterán
válasz
m.zmrzlina
#11607
üzenetére
Az újabb D1 határ után törölheted a D1 tartalmát, és indulhatsz nulláról, ABC szerint rendezett szavakkal.
-
#11606
Delila_1
veterán
m.zmrzlina
#11604
Delila_1
veterán
válasz
m.zmrzlina
#11604
üzenetére
Minden válasz, vagy ellenőrzés után növeld az értéket egy cellában, a tartományt pedig rendezd a hibapontokat tartalmazó oszlop szerin csökkenő sorrendbe.
A szavak számától függően, de pl. 100 db válasz után a Randbetween értékhatárát 1 és X közé állítsd be.Ez a számláló cella legyen pl. a D1 az aktuális lapon. Ha ennek az értéke 100 alatt van, akkor az Rnd legyen úgy, ahogy írtad. A rendezést minden válasz után megcsinálod.
Ha a D1=100, akkor töröld a hibapontokat (a rendezés marad), és legyen az Rnd 1 és 20 között. Újabb D1 határnál abc szerint rendezheted ismét a szavakat az A oszlop szerint. -
#11603
Delila_1
veterán
m.zmrzlina
#11601
Delila_1
veterán
válasz
m.zmrzlina
#11601
üzenetére
Public sor%
Public WS1 As Worksheet, WS2 As Worksheet
Sub szavak()
Dim usor%
Set WS1 = Sheets("Munka1")
Set WS2 = Sheets("Munka2")
usor% = WS1.Range("A1").End(xlDown).Row
sor% = Int(Rnd() * usor%) + 1
WS2.Cells(1) = WS1.Cells(sor%, 1)
WS1.Cells(3) = sor%
End Sub
Sub ell()
Set WS1 = Sheets("Munka1")
Set WS2 = Sheets("Munka2")
sor% = WS1.Cells(3)
If WS1.Cells(sor%, 2) <> WS2.Cells(2) Then
WS1.Cells(sor%, 3) = WS1.Cells(sor%, 3) + 1
End If
End SubAz elsővel feldobod a szót a Munka2!A1-be, az Rnd-vel kiválasztott sor számát beírod a Munka1!C1-be. A másodikkal ellenőrzöd a Munka2!B1-be írt választ. Ha nem jó, a Munka1 lapon a 3. oszlop értékét növeled 1-gyel a Munka1!C1-edik sorában, ahonnan a szót kiválasztotta az Rnd.
Sok kérdés és ellenőrzés után ki tudod választani a Munka1 C oszlopából a legtöbbször tévesztett szavakat, ezeket másolod az eredeti szavak alá, és úgy irányítod a véletlent, hogy ezekre mutasson.
Szerk.: nem is kell másolni. Rendezed a Munka1 A:C tarományát a C oszlop szerint, és szűkíted az Rnd tartományát.
-
#11602
Delila_1
veterán
m.zmrzlina
#11601
Delila_1
veterán
válasz
m.zmrzlina
#11601
üzenetére
Helytelen válasz esetén a függvénnyel létrehozott sor egy cellájának az értékét növeled. X db kérdés után a randbetween alsó és felső határát ezeknek a számoknak a minimumával és maximumával határozhatnád meg.
Ez még nem az igazi, csak közelít. Az új értékhatárok előtt törlöd a helytelen válaszok oszlopát, az új határokkal megint feltöltöd az X kérdésre adott hibás válaszokkal. Így szűkítheted a tartományt, de biztosan van ennél jobb ötlet is.Úgy is csinálhatod, hogy a maximumot veszed alapul, és ezt bővíted fel- és le néhány sorral.
Szerk.:
A legtöbbször elhibázott szavakat a lista végére teszed, és a véletlen határait eszerint szabod meg. -
Delila_1
veterán
válasz
mr.nagy
#11565
üzenetére
Teszteld ezzel. Csak estefelé leszek gép közelében, addig biztosan kibuknak a hibák.
A makró első részében (a **-os sorig) az első lap 100. oszlopába teszek egy x-et ahhoz, hogy a második rész gyorsabb futású legyen. Ezt az oszlopot a végén törlöm. Ha foglalt a 100. oszlop (CV), a 100-at a replace funkcióval írd át egy üres oszlop számára. Négy helyen szerepel.Sub szamitas()
Dim WS1 As Worksheet, WS2 As Worksheet, sor%, usor1%, usor2%, lel
Set WS1 = Sheets("első")
Set WS2 = Sheets("második")
WS2.Select
usor1% = Range("G2").End(xlDown).Row
For sor% = 2 To usor1%
On Error GoTo Köv
lel = WS1.Range("E:E").Find(Cells(sor%, "E")).Row
Select Case WS1.Cells(lel, 1)
Case 380
Cells(sor%, 7) = WS1.Cells(lel, 7) + Cells(sor%, 7)
WS1.Cells(lel, 100) = "x"
Case 390
Cells(sor%, 7) = WS1.Cells(lel, 7) - Cells(sor%, 7)
WS1.Cells(lel, 100) = "x"
End Select
Köv:
Next
'***************************************************************************
WS1.Select
usor1% = Range("A2").End(xlDown).Row
For sor% = 2 To usor1%
If Cells(sor%, 1) = 380 And Cells(sor%, 100) <> "x" Then
usor2% = WS2.Range("E2").End(xlDown).Row + 1
Range(Cells(sor%, 2), Cells(sor%, 5)).Copy WS2.Cells(usor2%, 2)
Cells(sor%, 7).Copy WS2.Cells(usor2%, 7)
End If
Next
Columns(100) = ""
End Sub -
#11564
Delila_1
veterán
Mythunderboy
#11563
Delila_1
veterán
válasz
Mythunderboy
#11563
üzenetére
Ha a Munka1 lap A vagy B oszlopába írsz, a makró megcsinálja. Ezt a makrót a lapodhoz kell rendelned - amire több leírást találsz itt a fórumon.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Or Target.Column = 2 Then
Dim WS2 As Worksheet, usor%
Set WS2 = Sheets("Munka2")
Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Munka2").Range("A1:B1"), Unique:=True
usor% = WS2.Range("A1").End(xlDown).Row
WS2.Range("A1:B" & usor%).Sort Key1:=WS2.Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
End SubSzerk.: a régi makrót töröld ki.
-
#11562
Delila_1
veterán
Mythunderboy
#11561
Delila_1
veterán
válasz
Mythunderboy
#11561
üzenetére
Szívesen. Örülök, hogy összejött.
-
#11559
Delila_1
veterán
Mythunderboy
#11558
Delila_1
veterán
válasz
Mythunderboy
#11558
üzenetére
A hivatkozási értéken mit értesz? Függvényt?
Most az A oszlopba képleteket vittem be (amik a D oszlop azonos sorában lévő értéket szorozzák 2-vel). A B oszlopba különböző számokat tettem. A
Sub EgyeniErtekek()
Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Munka2").Range("A1:B1"), Unique:=True
End Submakró rendben átviszi a Munka2 lapra a két oszlopból azokat a sorokat, ahol az A érték a B-vel együtt egyszer fordul elő. Pl. ha az A oszlopban 2× szerepel 6, a B oszlop hozzájuk tartozó értéke különböző, akkor a Munka2 lapon is 2× lesz ott a 6-os, a különböző B értékkel. Ha viszont mind a két 6-oshoz azonos B tartozik, a másik lapon csak 1× jeleníti meg.
Az oszlopok első sora cím legyen, lehet hogy ennek hiánya miatt duplázta az első sort.
-
Delila_1
veterán
válasz
mr.nagy
#11552
üzenetére
Ez a makró megoldja, bár egyúttal megszünteti az ellenőrzés lehetőségét. Az eredeti értékeket tartalmazó G oszlopot el is rejthetted volna.
Sub szamitas()
Dim WS1 As Worksheet, WS2 As Worksheet, sor%, usor%, lel
Set WS1 = Sheets("első")
Set WS2 = Sheets("második")
WS2.Select
usor% = Range("G2").End(xlDown).Row
For sor% = 2 To usor%
lel = WS1.Range("E:E").Find(Cells(sor%, "E")).Row
If WS1.Cells(lel, 1) = 380 Then
Cells(sor%, 7) = WS1.Cells(lel, 7) + Cells(sor%, 7)
Else
Cells(sor%, 7) = WS1.Cells(lel, 7) - Cells(sor%, 7)
End If
Next
End Sub -
Delila_1
veterán
válasz
mr.nagy
#11550
üzenetére
Majd kiderül, jól értettem-e. Mindkét lapon a G oszlopbeli értéket kell összegezni, vagy a különbségüket kiszámolni? Kivonásnál melyik a kivonandó?
A képen az első lap G értékéből vontam ki a második G-jét, ill. összegeztem azokat.
A második lap H2 cellájának képlete:
=HA(INDIREKT("első!A"&HOL.VAN(E2;első!E:E;0))=380;INDIREKT("első!G"&HOL.VAN(E2;első!E:E;0))+G2;INDIREKT("első!G"&HOL.VAN(E2;első!E:E;0))-G2)
-
Delila_1
veterán
válasz
Pulsar
#11529
üzenetére
Az A oszlop formátuma nn. - a B oszlopé nnnn
Feltételes formázással megadhatod az A és B oszlopra, hogy ha a nap azonos a fölötte lévővel, akkor a betű színe legyen azonos a háttér színével. A képlet: =$C3=$C2
A C oszlopot el is rejtheted. Ott az első képlet a C4 cellában van, az A és B oszlopokban pedig a 3. sorban. A feltételes formázás A3-tól B sokadikig tart.
-
#11521
Delila_1
veterán
MaciLaci68
#11519
Delila_1
veterán
válasz
MaciLaci68
#11519
üzenetére
Én sem jöttem volna rá magamtól, segítséget kértem.
-
#11517
Delila_1
veterán
Mythunderboy
#11515
Delila_1
veterán
válasz
Mythunderboy
#11515
üzenetére
#11513
-
#11514
Delila_1
veterán
MaciLaci68
#11511
Delila_1
veterán
válasz
MaciLaci68
#11511
üzenetére
Megvan a rövid elérés.
Cells(1) = Range(Selection.Address).Name.Name
-
#11512
Delila_1
veterán
Mythunderboy
#11502
Delila_1
veterán
válasz
Mythunderboy
#11502
üzenetére
A makró az aktuális lap T oszlopába gyűjti az egyéni értékeket, majd átmásolja a Munka2 lap A oszlopába. Másolás után törli az ideiglenes T oszlopot.
Sub EgyeniErtekek()
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"T1"), Unique:=True
Columns("T:T").Copy Sheets("Munka2").Range("A1")
Columns("T:T").ClearContents
End Sub -
#11509
Delila_1
veterán
MaciLaci68
#11507
Delila_1
veterán
válasz
MaciLaci68
#11507
üzenetére
Kijelölöd a szöveget, és a Konvertálatlan (vagy valami hasonló nevű) gombot megnyomod.
-
#11508
Delila_1
veterán
MaciLaci68
#11503
Delila_1
veterán
válasz
MaciLaci68
#11503
üzenetére
Miért is van erre szükség? Hiszen ha van az aktív cellának neve, akkor a szerkesztőléc bal oldalán láthatod kiírva.
Ez a makró is végig böngészi a neveket, csak egy kicsit gyorsabban.
Sub CellaNeve()
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
On Error GoTo Hiba
If ActiveWorkbook.Names(i).RefersToLocal = Selection.Name Then
Range("A1") = ActiveWorkbook.Names(i).Name
Exit Sub
End If
Next
Hiba:
Cells(1) = "A " & ActiveCell.Address & " cella nincs elnevezve"
End Sub -
Delila_1
veterán
Ha egymás alatt vannak az összevont cellák, akkor a kijelölésük után a makrót indítva beírja mindegyikbe a fölötte lévő értéket hivatkozással.
Érdemes utána kijelölni az oszlopot, és saját magára irányítottan beilleszteni az értéküket.
Sub Cella_felosztás()
Selection.UnMerge
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
End Sub -
-
Delila_1
veterán
Ráállsz a cellára, Képletek, Képletvizsgálat, Elődök- vagy Utódok mutatása.
Ha másik lapon-füzetben van az előd, vagy utód, egy kis táblázat kinézetű ikon jelenik meg, szaggatott vonallal. Erre a szaggatottra duplán klikkelsz, és megjelenik a hivatkozás helye.
A hivatkozást kijelölve, okézva az adott helyre ugrik a fókusz. -
Delila_1
veterán
válasz
Pulsar
#11401
üzenetére
A linken jobb klikk, Mentés másként. Htm formátumban menti. Ezt megnyitod az Excelben, ez a füzet legyen az aktív.
Előtte már megnyitottad azt a füzetet, amibe bemásoltad a makrót, amit most indítasz.A "kapitányos" sorokat kitörli az a makró, amit először írtam, azt használd.
-
Delila_1
veterán
válasz
Pulsar
#11378
üzenetére
Kijavítottam a hibát. A htm formátumban mentett, és Excelben megnyitott fájlon futtatsd a makrót.
Sub Rend()
Dim usor%, sor%
Application.ScreenUpdating = False
Range("A:A,E:F").Delete Shift:=xlToLeft 'Oszlopok törlése
ActiveSheet.DrawingObjects.Delete 'Objektumok törlése
usor% = Range("A1").End(xlDown).Row - 1 'Felső sor%ok törlése
Rows("1:" & usor%).Delete Shift:=xlUp
Columns("A:C").UnMerge 'Összevonások megszüntetése
usor% = Range("A65536").End(xlUp).Row 'Dátum formátum
Range("A1:A" & usor%).Select
Selection.NumberFormat = "mmmm dd/"
Selection.SpecialCells(xlCellTypeBlanks).Select 'Üres cellák kitöltése az A oszlopban képlettel
Selection.FormulaR1C1 = "=R[-1]C"
Columns("A:A").Select 'Érték beillesztése a képletek helyére
With Selection
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("D1:D" & usor%).FormulaR1C1 = "=SEARCH(""Rendőr"",RC[-3])" 'Képlet a D oszlopba
For sor% = usor% To 3 Step -1 'Üres sorok törlése
If Cells(sor%, 2) = "" And IsError(Cells(sor%, 4)) Then Rows(sor%).Delete Shift:=xlUp
If IsNumeric(Cells(sor%, 4)) Then Range(Cells(sor%, 1), Cells(sor%, 3)).HorizontalAlignment = xlCenterAcrossSelection
Next
Columns(4).Delete Shift:=xlToLeft 'D segédoszlop törlése
Range("A1").Select
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
Pulsar
#11378
üzenetére
Mented a fájlt htm formátumban. Behívod az Excelbe, és lefuttatod az alábbi makrót, amit egy másik füzetben tárolsz.
Sub Rend()
Dim usor As Long, sor As Long
Application.ScreenUpdating = False
'Oszlopok törlése
Range("A:A,E:F").Delete Shift:=xlToLeft
'Objektumok törlése
ActiveSheet.DrawingObjects.Delete
'Felső sorok törlése
usor = Range("A1").End(xlDown).Row - 1
Rows("1:" & usor).Delete Shift:=xlUp
'Összevonások megszüntetése
Columns("A:C").UnMerge
'Dátum formátum
usor = Range("A65536").End(xlUp).Row
Range("A1:A" & usor).Select
Selection.NumberFormat = "mmmm dd/"
'Üres cellák kitöltése az A oszlopban képlettel
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
'Érték beillesztése a képletek helyére
Columns("A:A").Select
With Selection
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
'Üres sorok törlése
For sor = usor To 3 Step -1
If Cells(sor, 2) = "" Then Rows(sor).Delete Shift:=xlUp
Next
Range("A1").Select
Application.ScreenUpdating = True
End SubMivel a kapitányságok nem egyformán viszik be a dátumot, az A oszlopban lesz némi változatosság.
-
Delila_1
veterán
válasz
balu999
#11356
üzenetére
Több kép esetén beszúrod a több képet, beállítod a méretüket, elhelyezed.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Address
Case "$A$1"
If ActiveSheet.Shapes("Picture 1").Visible = True Then
ActiveSheet.Shapes("Picture 1").Visible = False
Else
ActiveSheet.Shapes("Picture 1").Visible = True
End If
Case "$A$2"
If ActiveSheet.Shapes("Picture 2").Visible = True Then
ActiveSheet.Shapes("Picture 2").Visible = False
Else
ActiveSheet.Shapes("Picture 2").Visible = True
End If
Case "$A$3"
If ActiveSheet.Shapes("Picture 3").Visible = True Then
ActiveSheet.Shapes("Picture 3").Visible = False
Else
ActiveSheet.Shapes("Picture 3").Visible = True
End If
End Select
End SubA Case kezdetű sorokban azt adod meg, hogy melyik cellára akarsz duplán kattintani, az alatta lévő sorokban pedig azt, melyik kép jelenjen meg - tűnjön el a duplaklikkre.
A sort folytathatod az End Select sorig. -
Delila_1
veterán
válasz
balu999
#11354
üzenetére
Szúrd be a képet, tedd a megfelelő helyre, állítsd be az ideális méretet.
A laphoz kell rendelned az alábbi makrót.
Az A1 cellára duplán klikkelve eltűnik, újabb duplaklikkre láthatóvá válik a kép.Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$A$1" Then
If ActiveSheet.Shapes("Picture 1").Visible = True Then
ActiveSheet.Shapes("Picture 1").Visible = False
Else
ActiveSheet.Shapes("Picture 1").Visible = True
End If
End If
End SubErre gondoltál?
-
Delila_1
veterán
válasz
Delila_1
#11322
üzenetére
Ímé szép magyar nyelven:
Jelöljük ki a szűréshez az oszlopot vagy a tartomány, illetve lista egyik celláját.
Válasszuk az Adatok menü Szűrő, majd Irányított szűrő parancsát.
Hajtsuk végre a megfelelő műveletet:
Ha az AutoSzűrőhöz hasonlóan helyben szeretnénk szűrni a tartományt vagy a listát, jelöljük be a Helyben szűrje választókapcsolót.
Ha a szűrés eredményét máshová szeretnénk másolni, jelöljük be a Más helyre másolja választókapcsolót, majd a Hova másolja mezőben adjuk meg a cella hivatkozását.
A cella kijelöléséhez ideiglenesen elrejthetjük a párbeszédpanelt a Panel elrejtése gombra kattintva. Jelöljük ki a cellát a munkalapon, majd kattintsunk a Panel megjelenítése gombra.
Jelöljük be a Csak az egyedi rekordok megjelenítése négyzetet.A szűrt listát másolhatod (ez már tőlem).
-
Delila_1
veterán
válasz
mr.nagy
#11312
üzenetére
Sub Négy()
Dim sor As Integer, usor As Integer, sor_1 As Integer
sor_1 = 1
usor = Range("A65536").End(xlUp).Row
For sor = 10 To usor
If sor_1 < 5 Then
Cells(sor_1, 1) = Cells(sor, 1)
sor_1 = sor_1 + 1
Else
sor_1 = 1
sor = sor - 1
MsgBox "Ide jön a nyomtatás"
'ide jön a nyomtatás
Range("A1:A4").ClearContents
End If
Next
End Sub -
Delila_1
veterán
válasz
mr.nagy
#11309
üzenetére
Sub Tizenhat()
Dim sor As Integer, usor As Integer, oszlop As Integer, sor_1 As Integer
oszlop = 1: sor_1 = 1
usor = Range("A65536").End(xlUp).Row
For sor = 10 To usor
If sor_1 < 5 Then
Cells(sor_1, oszlop) = Cells(sor, 1)
sor_1 = sor_1 + 1
Else
sor_1 = 1
oszlop = oszlop + 4
sor = sor - 1
End If
If oszlop = 17 Then
MsgBox "Ide jön a nyomtatás"
'ide jön a nyomtatás
Range("A1:A4,E1:E4,I1:I4,M1:M4").ClearContents
oszlop = 1
End If
Next
End Sub -
Delila_1
veterán
válasz
mr.nagy
#11298
üzenetére
Az adat laphoz rendeld a makrót.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$5" Then
Dim meret As Integer
Select Case Len(Range("A6"))
Case Is <= 40
meret = 18
Case 41 To 100
meret = 16
Case 101 To 200
meret = 14
Case Is > 200
meret = 12
End Select
Range("A6").Font.Size = meret
End If
End Sub -
-
Delila_1
veterán
válasz
mr.nagy
#11296
üzenetére
Le kellene pontosan írnod. Milyen nevű lapon, melyik cellában van az fkeres keresési értéke, mert ettől változik a szöveged hossza.
Írd meg a lap nevét, és a tartományt, ahol keres az Fkeres.
Milyen nevű lapon van az A6:D6 összevont cellád?Szerk.: legjobb, ha beteszel egy képet a két lapról úgy, hogy a lapneveket is lehessen látni.
-
Delila_1
veterán
válasz
mr.nagy
#11294
üzenetére
A
Select Case Len(Target.Value)sor helyett
Select Case Len(cells(Target.row,5).Value)legyen. Az 5 az E oszlop, ahelyett annak az oszlopnak a számát írd be, ahol a hosszú szövegek megjelennek.
A Case kezdetű sorokban a Range(Target.Address).Font.Size helyére cells(target.row,5) kerüljön.
A
Set ter = Intersect(Target, Range("A6:D6"))
sorban az a terület legyen, ami előidézi a szövegek változását.Tehát ha az A6:D6 tartományt változtatod, és ennek hatására az E oszlopban változik a szöveg, akkor működik a most mutatott új sorral.
-
Delila_1
veterán
válasz
mr.nagy
#11292
üzenetére
A laphoz rendeld az alábbi makrót:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ter As Range
Set ter = Intersect(Target, Range("A6:D6"))
If ter Is Nothing Then
Select Case Len(Target.Value)
Case Is <= 40
Range(Target.Address).Font.Size = 18
Case 41 To 100
Range(Target.Address).Font.Size = 16
Case 101 To 200
Range(Target.Address).Font.Size = 14
Case Is > 200
Range(Target.Address).Font.Size = 12
End Select
Else: Exit Sub
End If
End Sub -
Delila_1
veterán
válasz
mr.nagy
#11278
üzenetére
Így gondoltad?
Sub Tizenhat()
Dim sor As Integer, usor As Integer, oszlop As Integer, sor_1 As Integer
oszlop = 3: sor_1 = 2
usor = Range("B65536").End(xlUp).Row
For sor = 13 To usor
If sor_1 < 6 Then
Cells(sor_1, oszlop) = Cells(sor, 2)
sor_1 = sor_1 + 1
Else
sor_1 = 2
oszlop = oszlop + 4
sor = sor - 1
End If
If oszlop = 19 Then
MsgBox "Ide jön a nyomtatás"
'ide jön a nyomtatás
Range("C2:R5").ClearContents
oszlop = 3
End If
Next
End Sub -
Delila_1
veterán
válasz
pitman
#11231
üzenetére
Már csak azt nem értem, mi az
![;]](//cdn.rios.hu/dl/s/v1.gif)
-nek érvényesítés! Egy szép hosszú, egészséges képlettel be tudod íratni a B5-be az 1-et, vagy 2-t. A felhasználó úgyis csak azt választhatná a két érték közül, ami a B1 és a B2 értéke szerint 1, vagy 2.=HA(ÉS(B1<>"M";SZÁM(HOL.VAN(B2;H2:I2;0)));1;HA(ÉS(B1="M";SZÁM(HOL.VAN(B2;J2:K2;0)));2;""))
Ha egyik feltétel sem igaz, akkor üres string kerül a B5-be.
A B6-ban az =B5=1 képlet IGAZ eredményt ad, ha valóban egyenlő a B5 1-gyel, minden más esetben HAMIS lesz az értéke. Nem tudom erre van-e szükség.
-
Delila_1
veterán
Csak annyit kell tudni a feladathoz, hogy a MA() függvény mindig az aktuális dátumot adja. Az ehhez hozzáadott, vagy ebből kivont másik dátum a két dátum közötti napok számát adja.
Vegyük, hogy a garanciális idő lejárata az A2 cellában van.
Szövegesen kiírja a hátra lévő napok számát, vagy azt, hogy hány napja járt le a garancia:
=HA(A2>MA();"Még " & A2-MA() & " napig garanciális"; MA()-A2 & " napja járt le a garancia")Másik forma, amivel tovább tudsz számolni, pozitív, vagy negatív értékkel adja meg ezeket a napokat. Ami lejárt, az negatív értékkel jelenik meg.
=HA(A2>MA(); A2-MA(); (MA()-A2)*-1 )
Az egységárat a kapott értékkel arányosan tudod felosztani. -
#11223
Delila_1
veterán
m.zmrzlina
#11222
Delila_1
veterán
válasz
m.zmrzlina
#11222
üzenetére
Végre valami jó hír.
Szívesen. -
#11221
Delila_1
veterán
m.zmrzlina
#11220
Delila_1
veterán
válasz
m.zmrzlina
#11220
üzenetére
Meg lehetne még próbálni a terület 1-gyel való szorzását (irányítottan), hátha az eltüntetné a láthatatlan karaktereket, és számmá alakítaná a cellák tartalmát.
-
#11219
Delila_1
veterán
m.zmrzlina
#11218
Delila_1
veterán
válasz
m.zmrzlina
#11218
üzenetére
Lusta vagyok kikeresni, melyik hsz-re vonatkozott ez az írásod.
Egyszerűbben is eltávolíthatod az első karaktert.
=jobb(a1;hossz(a1)-1) -
#11216
Delila_1
veterán
m.zmrzlina
#11214
Delila_1
veterán
válasz
m.zmrzlina
#11214
üzenetére
-
#11213
Delila_1
veterán
m.zmrzlina
#11211
Delila_1
veterán
válasz
m.zmrzlina
#11211
üzenetére
Kinézetre az A oszlopban számok, az E-ben szövegek vannak, azért nincs egyezés.
-
#11205
Delila_1
veterán
m.zmrzlina
#11204
Delila_1
veterán
válasz
m.zmrzlina
#11204
üzenetére
A hol.van megtalálja, akár csupa betű, akár vegyesen van számmal.
-
#11203
Delila_1
veterán
m.zmrzlina
#11202
Delila_1
veterán
válasz
m.zmrzlina
#11202
üzenetére
Óriási hibát követtem el, kihagytam 1 zárójelet (és az Excel nem kiabált rám).
Gyönyörűen működik.
-
#11201
Delila_1
veterán
m.zmrzlina
#11199
Delila_1
veterán
válasz
m.zmrzlina
#11199
üzenetére
Ez klassz ötlet!
Szerk.: sajnos számot nem enged beírni, pedig a képlet alapján úgy nézett ki.
![;]](http://cdn.rios.hu/dl/s/v1.gif)
-nek érvényesítés! Egy szép hosszú, egészséges képlettel be tudod íratni a B5-be az 1-et, vagy 2-t. A felhasználó úgyis csak azt választhatná a két érték közül, ami a B1 és a B2 értéke szerint 1, vagy 2.
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Assassin's Creed Shadows Collector's Edition PC
- Tablet felvásárlás!! Samsung Galaxy Tab A8, Samsung Galaxy Tab A9, Samsung Galaxy Tab S6 Lite
- Csere-Beszámítás! RTX Számítógép PC Játékra! R5 8400F / RTX 3070Ti / 32GB DDR5 / 1TB SSD
- Azonnali készpénzes AMD CPU AMD VGA számítógép felvásárlás személyesen / postával korrekt áron
- Honor Magic 7 Pro - Fekete - Új kipróbált készülék! Karcmentes gyárilag független! 512GB Memória!
- REFURBISHED - HP USB-C Dock G4 docking station (L13899-001)
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest