- Xiaomi 15 - kicsi telefon nagy energiával
- Samsung Galaxy S25 - végre van kicsi!
- One mobilszolgáltatások
- iPhone topik
- Garmin Venu X1 - vékony, virtuóz, váltságíjas
- Motorola Edge 50 Neo - az egyensúly gyengesége
- Samsung Galaxy Watch7 - kötelező kör
- Android alkalmazások - szoftver kibeszélő topik
- Samsung Galaxy Watch6 Classic - tekerd!
- Google Pixel topik
Hirdetés
Köszönjük a sok biztatást, támogatást! Egy rövid ideig még féláron tudsz hirdetni, előfizetni!
-
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
-
Delila_1
veterán
válasz
plaschil
#23757
üzenetére
Függvénnyel nem, de egy rövid kis makróval megoldható.
Sub Hiba()
Dim ter As Range, CV As Range, usor As Long
Sheets("A").Activate
usor = Cells(1).End(xlDown).Row
Set ter = Range("A1:A" & usor)
For Each CV In ter
If CV.Interior.Color = vbRed Then Sheets("B").Cells(CV.Row, "X") = "Hiba"
Next
End SubA Sheets("A").Activate, és az
If CV.Interior.Color = vbRed Then Sheets("B").Cells(CV.Row, "X") = "Hiba"
sorokban írd be az "A" és "B" helyére a lapjaid igazi nevét, idézőjelek között. -
Delila_1
veterán
válasz
plaschil
#13390
üzenetére
Nem adtad meg, hogy az Excelnek melyik verzióját alkalmazod.
Ha 2007-et, vagy 2010-et, akkor a Szumhatöbb függvényt használd, ha alacsonyabb verziód van, akkor fel kell venned egy segédoszlopot.
A D1 cella legyen: =A1&" "&B1, ezt másold le az adataid mellé.
Az összegző oszlop 1. cellájába ezt írd: =SZUMHA(D:D;A1&" "&B1;C:C), és másold le. -
Delila_1
veterán
válasz
plaschil
#13220
üzenetére
A makró az N oszlopba kigyűjti az A oszlopban lévő szövegeket, és mindegyik mellé beírja csökkenő sorrendben a hozzá tartozó top5-öt az O:S oszlopba.
Ha 100-nál több féle adatod lehet az A oszlopban, a makróban jelzett sorban írhatod át.Sub Top5()
Dim sor As Long, sor1 As Long
Dim usor As Long, usor1, cim, ertek
Dim T(100, 5) '***** Itt írd át a 100-at *****
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
usor = ActiveSheet.UsedRange.Rows.Count
Columns("A:A").Select
Range("A1:A" & usor).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"N1"), Unique:=True
usor1 = Range("N1").End(xlDown).Row
For sor1 = 2 To usor1
cim = Cells(sor1, 14)
For sor = 2 To usor
ertek = Cells(sor, 2)
If Cells(sor, 1) = cim Then
If ertek > T(sor1 - 1, 1) Then
T(sor1 - 1, 5) = T(sor1 - 1, 4)
T(sor1 - 1, 4) = T(sor1 - 1, 3)
T(sor1 - 1, 3) = T(sor1 - 1, 2)
T(sor1 - 1, 2) = T(sor1 - 1, 1)
T(sor1 - 1, 1) = ertek
GoTo Köv
End If
If ertek > T(sor1 - 1, 2) Then
T(sor1 - 1, 5) = T(sor1 - 1, 4)
T(sor1 - 1, 4) = T(sor1 - 1, 3)
T(sor1 - 1, 3) = T(sor1 - 1, 2)
T(sor1 - 1, 2) = ertek
GoTo Köv
End If
If ertek > T(sor1 - 1, 3) Then
T(sor1 - 1, 5) = T(sor1 - 1, 4)
T(sor1 - 1, 4) = T(sor1 - 1, 3)
T(sor1 - 1, 3) = T(sor1 - 1, 2)
T(sor1 - 1, 3) = ertek
GoTo Köv
End If
If ertek > T(sor1 - 1, 4) Then
T(sor1 - 1, 5) = T(sor1 - 1, 4)
T(sor1 - 1, 4) = T(sor1 - 1, 3)
T(sor1 - 1, 4) = ertek
GoTo Köv
End If
If ertek > T(sor1 - 1, 5) Then T(sor1 - 1, 5) = ertek
End If
Köv:
Next
Range("O" & sor1) = T(sor1 - 1, 1)
Range("P" & sor1) = T(sor1 - 1, 2)
Range("Q" & sor1) = T(sor1 - 1, 3)
Range("R" & sor1) = T(sor1 - 1, 4)
Range("S" & sor1) = T(sor1 - 1, 5)
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub -
-
Delila_1
veterán
válasz
plaschil
#12801
üzenetére
Az első IF-en belül két újabb kritérium már eleve hamis ágra fut.
Az első feltétel vizsgálja az E oszlop i-edik értékét, és csak akkor jut el az igaz ágba, ha ez az érték 72. Te ebbe az igaz ágba teszel két újabb feltételt, ami azt vizsgálja, hogy ugyanez a cella 0.603-mal, vagy 0.615-tel kezdődik-e.
-
plaschil
aktív tag
válasz
plaschil
#12801
üzenetére
Javítás:
Nem így:
' itt kellene egy olyan rész hogy ami az i-edik sorban (elvileg megfelel a szűrésnek) ebből a sorból kéne néhány ***oszlopot*** átteni egy másik fájl végére.
Hanem így:
' itt kellene egy olyan rész hogy ami az i-edik sorban (elvileg megfelel a szűrésnek) ebből a sorból kéne néhány ***cellát*** átteni egy másik fájl végére.
-
Delila_1
veterán
válasz
plaschil
#12796
üzenetére
For i = 1 To SorokSzama
If Cells(i, 5) = 72 Then
If Cells(i, 4) = "5415" Or "5415B" Then
If Left(Cells(i, 2), 2) = "ez" Or Left(Cells(i, 2), 2) = "az" Or _
Left(Cells(i, 2), 4) = "emez" Or Left(Cells(i, 2), 4) = "amaz" Then
'történjen valami
Else
'történjen valami más
End If
End If
End If
Next -
plaschil
aktív tag
válasz
plaschil
#12796
üzenetére
Úgy tűnik mintha nem lehetne megadni több feltételt egy if-ben. Érdekes. Na de ha így nem megy, akkor megírom minden feltételre egyesével az if-et azon nem múlik. Viszont akkor azzal az akadállyal kell megküzdenem, hogy meg kell vizsgálnom, hogy pl. "XXX"-el kezdődik-e egy adott cella tartalma.
-
-
plaschil
aktív tag
válasz
plaschil
#12791
üzenetére
No azt hiszem ezt megoldottam. További problémák merültek fel: fel szeretném vetetni makróval, hogy az egy oszlopban lévő 4 db szűrési feltételnek megfelelő sorok legyenek szűrve. Hogy egyszerűbb? Ha felvetetem, vagy ha megnézem hány soros a fájl és IF-el megcsinálom? Csak azért mert pl. 2 feltételnél még működik (makró rögzítésnél) de 4-nél már nem.
ActiveSheet.Range("$A$1:$FM$5909").AutoFilter Field:=2, Criteria1:= _
"=szoveg_1*", Operator:=xlOr, Criteria2:="=szoveg_2*", Operator:=xlOr, Criteria3:="=szoveg_3*", Operator:=xlOr, Criteria4:="=szoveg_4*", Operator:=xlOr
Ezzel a 4 feltétellel nem szűri le az adatokat. De ha csak 2-őt adok meg akkor igen.
Ötlet? -
poffsoft
veterán
válasz
plaschil
#12569
üzenetére
Ha azért véded, hogy véletlen ne törölj bele, akkor célszerű üres jelszóval levédeni a lapot. Ha mások szándékos törlése ellen véded, akkor persze kell jelszó. A jelszó birtokában bárki feloldhatja a lapvédelmet.
Ha bekapcsolod a lapvédelmet, csak azok a cellák lesznek módosíthatók, amikből a formátum/védelem-nél kivetted a pipát, alapból minden cella ki van pipálva, igen. A korrektúrás megoldást én nem ismerem. -
, vagyis a VBA azért megeszi, csak mást csinál, mint amit te akarsz.
Ötlet?
Új hozzászólás Aktív témák
Fferi50
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- PC Game Pass előfizetés
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- HIBÁTLAN iPhone 15 Pro 256GB Natural Titanium -1 ÉV GARANCIA - Kártyafüggetlen, MS3002, 90% Akksi
- Konzol felvásárlás!! Xbox Series S, Xbox Series X
- Bezámítás! Lenovo Legion 5 17ACH6H Gamer notebook - R7 5800H 16GB DDR4 512GB SSD RTX 3060 6GB WIN11
- Honor Pad X8 64GB, Wi-Fi, 1 Év Garanciával
- iKing.Hu - Xiaomi 14 Ultra Ultra White Használt, karcmentes állapot, Kamerás csúcsmobil
Állásajánlatok
Cég: FOTC
Város: Budapest