Hirdetés
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- Luck Dragon: Asszociációs játék. :)
- GoodSpeed: Márkaváltás sok-sok év után
- gban: Ingyen kellene, de tegnapra
- GoodSpeed: 3I/Atlas: Üstökös vagy idegen civilizáció űrhajója?
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- sziku69: Fűzzük össze a szavakat :)
- bb0t: Ikea PAX gardrób és a pokol logisztikája
- sziku69: Szólánc.
- LordAthis: Mission: Imposible? - Együtt 1333 és 1600 MHz, ECC/Non-ECC
-
LOGOUT
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
mormota
#33050
üzenetére
Egy üres füzetben modulba másold be a makrót.
Sub Szetcincalas()
Dim sor As Long, usor As Long
Dim WSF As Worksheet, WSS As Worksheet
Const utvonal = "D:\Tmp\" 'ide jön a saját útvonalad
On Error Resume Next
Workbooks.Open Filename:=utvonal & "Forrás.xlsx"
On Error GoTo 0
On Error Resume Next
Workbooks.Open Filename:=utvonal & "Sablon.xlsb"
On Error GoTo 0
Set WSF = Workbooks("Forrás.xlsx").Sheets(1) 'saját füzeted és lapod neve
Set WSS = Workbooks("Sablon.xlsb").Sheets(1) 'saját füzeted és lapod neve
usor = WSF.Range("F" & Rows.Count).End(xlUp).Row
WSS.Activate
For sor = 2 To usor
Cells(1, "C") = WSF.Cells(sor, "F")
Cells(2, "C") = WSF.Cells(sor, "G")
Cells(3, "C") = WSF.Cells(sor, "L")
Cells(4, "C") = WSF.Cells(sor, "H")
ActiveWorkbook.SaveAs Filename:=utvonal & Range("C3") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Next
MsgBox "Kész"
End SubÍrd át a 3 jelzett sorban az útvonalat, a fájlneveket, és hogy hányadik lapon vannak az adatok a forrás és a sablon füzetekben. Adj rá mentést, Makrós.xlsm-ként.
A makró megnyitja a sablon és forrás fájlokat, elvégzi a másolást, menti az aktuális C3 néven a fájlt.
-
Delila_1
veterán
válasz
Carasc0
#33037
üzenetére
ThisWorkbookba
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:10"), "OsszegKiiras"
End SubModulba
Sub OsszegKiiras()
Beep
MsgBox Application.WorksheetFunction.Sum(Sheets("Munka3").Range("C4:C15")) '***
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
End SubA csillagokkal jelzett sorban a saját lapod, saját összegzendő tartományod címét add meg!
-
Delila_1
veterán
-
Delila_1
veterán
válasz
lenkei83
#32993
üzenetére
Azt nem mondtad, hogy nem userformon, hanem egy lapon van a combobox.
Az Alapadatok lapon a C4:C11 tartományt érdemes táblázattá alakítani. A C5:C11-et kijelölve megadtam a Teszt nevet (előtte töröltem a régit). Az ofszetes tartományod nem volt jó, C5-től C12-ig tartott. Persze nem nagy baj, ha pluszban van egy üres sor.
A Combobox lapon beállítod a Tervező módot, a vezérlődre állva megjeleníted a Tulajdonságokat. Itt a ListFillRange opcióhoz beírod: Teszt
Szerk.: azért elég a Teszt szót beírni, mert a tartomány hatóköre az egész munkafüzetre vonatkozik.
-
#32979
Delila_1
veterán
konigjanos
#32977
Delila_1
veterán
válasz
konigjanos
#32977
üzenetére
Egy sima hivatkozást kell a másik táblába írnod. Pl. a C5 cellában az =A1 beírja a C5-be az A1 cella aktuális értékét. Mikor átírod az A1 értékét, az új jelenik meg a C5-ben
-
Delila_1
veterán
válasz
retesz147
#32958
üzenetére
Adj mentést a füzetedre. Nyiss egy új füzetet, aminek egy moduljába (lásd a Téma összefoglalót) beviszed az 1 soros makrót.
Sub mm()
Rows(ActiveSheet.UsedRange.Rows.Count + 1 & ":" & Rows.Count).Delete
End SubÁllj a kérdéses füzeted kérdéses lapjára, és indítsd a makrót – Alt +F8-ra feljön egy ablak, ahol kiválaszthatod az mm címűt.
Nézd meg, rendbejött-e. Ha igen, adj új mentést a füzetre.Ez a makró megkeresi a füzetben azt a sort, ahol az utolsó bevitt érték van, és az alatta lévő sorokat törli.
Ha valamikor volt egy adat jóval lejjebb, amit később töröltetek, az Excel megjegyzi ezt az egyszeri beírást, és ennek a soráig állítja be a görgető sávot. A makró "elfelejteti" a hajdani beírást.
-
#32917
Delila_1
veterán
s7evcsenko
#32916
Delila_1
veterán
válasz
s7evcsenko
#32916
üzenetére
Szívesen.
-
#32914
Delila_1
veterán
thomas50.000
#32913
Delila_1
veterán
válasz
thomas50.000
#32913
üzenetére
Nincs mit.
-
#32912
Delila_1
veterán
s7evcsenko
#32910
Delila_1
veterán
válasz
s7evcsenko
#32910
üzenetére
A képletben a $ jellel rögzítettem a B oszlopot. Ez azt jelenti, hogy minden sorban a B oszlop értékét veszi feltételként alapul, mégpedig az érvényességi területként meghatározott (A:B) oszlopokban.
-
#32909
Delila_1
veterán
s7evcsenko
#32905
Delila_1
veterán
válasz
s7evcsenko
#32905
üzenetére
Így add meg a feltételes formázás képletét.
-
#32908
Delila_1
veterán
thomas50.000
#32902
Delila_1
veterán
válasz
thomas50.000
#32902
üzenetére
Az End With sor fölé vidd be:
.Width = 22.67717 -
-
#32860
Delila_1
veterán
botond2225
#32859
Delila_1
veterán
válasz
botond2225
#32859
üzenetére
A makró első sora ez legyen:
Application.Volatile
Akkor frissül, mikor a lapra billentyűzetről viszel be valamit, vagy törlöd egy cella tartalmát.
-
#32858
Delila_1
veterán
botond2225
#32857
Delila_1
veterán
válasz
botond2225
#32857
üzenetére
Kipróbáltad a függvényt?
Abban a füzetben lesz elérhető, amelyiknél egy modulba beírtad. -
#32854
Delila_1
veterán
botond2225
#32853
Delila_1
veterán
válasz
botond2225
#32853
üzenetére
Ehhez egy saját függvény kell.
Beírod a H oszlopba (H2-től kezdve) a keresendő szöveget (9'' Quad Core), mellé az I-be a GA33-at, alá a többi párost.
Modulba másold be a makrót.
Function Rovidites(Cella As Range)
Dim sor As Integer, usor As Integer
usor = Range("H" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
If InStr(Cella.Value, Range("H" & sor)) > 0 Then
Rovidites = Range("I" & sor).Value
Exit For
End If
Next
End FunctionHa a hosszú szöveged az A2-ben van, akkor a képlet
Rovidites(A2). Ugyanúgy másolható, mint a többi függvény.Vigyázz! a hosszú szövegedben a 9 után 2 db aposztróf van, a keresési feltételnél meg 1 db idézőjel.
-
Delila_1
veterán
válasz
Declare
#32811
üzenetére
Sub HarmasFeladat()
Dim sor As Long, usor As Long
Application.ScreenUpdating = False
usor = Range("F" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
Select Case Cells(sor, "F")
Case "Value1"
Cells(sor, "H") = "=F" & sor
Case "Value2"
Cells(sor, "I") = "=F" & sor
Case "Value3"
Cells(sor, "J") = "=F" & sor
End Select
Next
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
Declare
#32811
üzenetére
Tényleg működik az egyenlőség jeles, de anélkül is.
A bemásolt makród is hiba nélkül lefut nálam üres sorok esetén is, csak ugrál. Először az alsó Value2 sorba ír, majd az első Value1-be, utolsó Value3-ba, első Value2-be, stb.
Az én makrómban a
Do While Cells(sor, "G") > ""
sorban a G-t írd át F-re. -
Delila_1
veterán
válasz
Declare
#32807
üzenetére
Azt hiszem, túlbonyolítod a feladatot. Minek ide-oda ugrálni? Elég egyszer végigmenni az adatokon.
A makróban elég bugyuta feladatokat adtam meg a 3 különböző értékre.
Value1-nél a H oszlop azonos sorába írja be hivatkozással az F aktuális sorának az értékét. a másik kettőnél az I-be, ill. a J-be.Sub HarmasFeladat()
Dim sor As Long
Application.ScreenUpdating = False
sor = 2
Do While Cells(sor, "G") > ""
Select Case Cells(sor, "G")
Case "Value1"
Cells(sor, "H") = "=F" & sor
Case "Value2"
Cells(sor, "I") = "=F" & sor
Case "Value3"
Cells(sor, "J") = "=F" & sor
End Select
sor = sor + 1
Loop
Application.ScreenUpdating = True
End Sub -
#32806
Delila_1
veterán
terencehIII
#32803
Delila_1
veterán
válasz
terencehIII
#32803
üzenetére
Itt egy füzet, benne a válasz.
A területeket, ahol a képek vannak, elnevezed. A Hiperhivatkozásnál a definiált nevek közül választasz.
-
#32805
Delila_1
veterán
thomas50.000
#32804
Delila_1
veterán
válasz
thomas50.000
#32804
üzenetére
A másik fórumon, ahol feltetted a kérdést, válaszoltam.
-
Delila_1
veterán
Azt nem írtad, hogy a két tábla azonos-, vagy külön lapon van-e, és hol helyezkednek el a lap(ok)-on.
Azt az esetet vettem, mikor a Munka1 és Munka2 lapokon vannak, mindkét esetben Az A1:Px tartományban, címsorral.
A makrót modulba kell másolnod. A Munka1 és Munka2 neveket írd át a saját lapjaid nevére.
Sub Osszevonas()
Dim sor As Long, usor As Long, honnan
Sheets("Munka1").Select
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = usor To 2 Step -1
Rows(sor).EntireRow.Insert
honnan = Application.Match(Cells(sor + 1, 1), Sheets("Munka2").Columns(1), 0)
Sheets("Munka2").Rows(honnan).Copy Sheets("Munka1").Range("A" & sor)
Next
End SubSzerk.: nem írtam bele hibakeresést, feltételezve, hogy a nevek azonosak a két lapon.
-
Delila_1
veterán
Privátban 2 napja elküldtem a fájlt is, a jó képletekkel. Meg is köszönted, Mi a baj?
Szerk.:
Az eredeti képen, amit priviben küldtél, nem a hetedik, hanem a 39. sorban kezdődtek az adataid. Az általam küldött fájlban töröld ki felülről a felesleges sorokat, a képletek rugalmasan hozzá alakulnak az új elrendezéshez. -
Delila_1
veterán
Nem egészen pontos a megfogalmazásod. "Van egy oszlop, mondjuk E, az ebben szereplő összegeket szeretném összeadni, ha a K, vagy a L, vagy az M, vagy az N oszlopokban szerepel "X"."
Mit akarsz összeadni?
Nem az a feladat, hogy soronként, ha a K:M tartományban bárhol X található, akkor írja ki az adott sor E cellájának az értékét? Ha igen, a=HA(VAGY(K1="X";L1="X";M1="X";N1="X");E1;0)
képlettel megoldható.Ha viszont az a kérdés, hogy ha bárhol a K:N tartományban található X, akkor írja ki az E oszlop összegét, akkor a
=HA(DARABTELI(K:N;"X")>0;SZUM(E:E);0)
képlet ad megoldást. -
-
#32711
Delila_1
veterán
TrollBalint
#32710
Delila_1
veterán
válasz
TrollBalint
#32710
üzenetére
Az A oszlopot másold át az F-be. Az adathalmazból az ismétlődések eltávolítása menüpontot alkalmazva minden neved egyszer fog szerepelni ebben az oszlopban.
A képen látható képleteket vidd be a G és H oszlopba, ezekből kiszámíthatod a legkisebb és legnagyobb időpontok között eltelt időt.
A G oszlop képlete akkor lesz megfelelő, ha a B oszlopban növekvő sorrendben vannak az idők.Az FKERES angol megfelelője a VLOOUP, a Keres-é a LOOKUP.
-
Delila_1
veterán
Fussunk neki újra.
A1-B1 összevonva, a tartalma tűzoltó anyag 13.c Szóköz van az anyag és a 13.c között?
Ebből kell ta_13.c-t összehozni a szövegfüggvényekkel, és ez a rövidített változat az egyik lap neve.
A következő leendő-, vagy meglévő lapnév az A2-B2 cellák értékéből adódik?Minden cella megnevezése 2 szóból áll? Ez fontos a rövidítés létrehozásához.
A képlet, ami létrehozza a rövidített nevet
=BAL(A1;1)&KÖZÉP(A1;SZÖVEG.KERES(" ";A1)+1;1)&"_"&KÖZÉP(A1;SZÖVEG.KERES(" ";A1;SZÖVEG.KERES(" ";A1)+1)+1;10) -
Delila_1
veterán
válasz
Fferi50
#32679
üzenetére
Igen, megírta a srác, meg is néztem – de csak most, eddig nem voltam net közelében. Azt nem tudta ott megadni, hogy userformról és tetxboxról van szó.
Kevés adat van a füzetben, kicsi a memória-foglalás. 3 változó közül 1-et beír nála a lapra, kettőt nem. A hibakód van vagy 20 karakternyi, ami nem normális. Több helyen keresgélt a neten. Mindenhol azt írják hasonló esetről, hogy nem aktív a lap, ahova menteni akar. Nem is kell annak lennie, és az sem segített, hogy a cellába írás előtt aktiváltam a lapot. Szerintem az ő készülékében (Office) van a hiba.
-
Delila_1
veterán
válasz
Fferi50
#32671
üzenetére
Velem is hasonló anomália lépett fel. Nálam pompásan működik a két sor:
usor = Sheets("Alapadatok").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Alapadatok").Range("A" & usor) = UjMTahol az UjMT egy beviteli mező egy userformon. Akinek küldtem, nála hibával leáll, nem elérhető az objektum.
Próbáltam szétszedni a sort:Sheets("Alapadatok").Select
Range("A" & usor) = UjMTErre is fütyül. A változókat felismeri, a lap nem védett. Megállt a tudományom.
EmberXY:
a
Range(talal).End(xlDown).Selecthelyett írj
Range(talal).End(xlDown).Offset(1).Select-et, hogy az első üres sorban legyen a fókusz. -
Delila_1
veterán
válasz
EmberXY
#32661
üzenetére
Egy alternatív megoldásnál az A oszlopba sima egyenlőségjellel behivatkozod az egyes tábláid bal felső celláját a csatolt kép szerint. A makró elintézi, hogy bárhova elmozdíthatod az egyes táblákat, szúrhatsz be vagy törölhetsz sorokat, ill. oszlopokat, az A oszlop cellájára kattintva mindig a megfelelő tábla első oszlopának alsó cellájára ugrik a fókusz.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim talal
If Target.Column = 1 Then
Application.EnableEvents = False
talal = Columns("B:DZ").Find(Target, LookIn:=xlValues).Address
Range(talal).End(xlDown).Select
Application.EnableEvents = True
End If
End SubSzerk.: a Columns("B:DZ") kifejezésben a DZ helyett írhatsz "nagyobb" értéket.
-
Delila_1
veterán
Esetleg a laphoz rendelt makróval megszüntethetnéd a feltételes formázást. A lenti makró duplakliikre megszünteti a kijelölt tartomány feltételes formázását, majd sárga hátteret állít be a kijelölt cellára.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Selection.FormatConditions.Delete 'törli a feltételes formázást
Selection.Interior.ColorIndex = 6 'sárga hátteret állítbe
Cancel = True
End SubAdhatsz más új hátteret is, pl. lilát.
Selection.Interior.Color = RGB(255, 0, 255)Az RGB-vel bármilyen színt kikavarhatsz.
-
Delila_1
veterán
válasz
Smogus
#32638
üzenetére
Nem írtad, hol van az a cella. A lenti makró az A oszlopba írt adat esetén az azonos sor B oszlopába írja be az időpontot.
Az A oszlopba írást az If Target.Column = 1 Then sor figyeli. Ha másik oszlopot kellene figyelembe venni, az 1-et írd át az oszlop sorszámára. (B-nél 2, C-nél 3, és így tovább).
A makrót a lapodhoz kell rendelni, ahogy a Téma összefoglalóban olvashatod.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Application.EnableEvents = False
Range(Target.Address).Offset(, 1) = Format(Time, "hh:mm:ss")
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
válasz
Fferi50
#32573
üzenetére
Mindenképp szét kell választani a fekete és piros neveket, mert a feladat, "megtudni, hogy meny nevek szerepelnek mindkét névsorban?"
Ez biztosan valami iskolai feladat. Nem láttam még olyan – barbár – megoldást, hogy két névsort 1 oszlopba tett valaki, és még együtt is rendezte volna a kettőt.
-
#32571
Delila_1
veterán
Kalogenius
#32570
Delila_1
veterán
válasz
Kalogenius
#32570
üzenetére
Eleve 2 külön oszlopba kellene szétdobni a 2 tartományt.
Beszúrsz egy címsort, majd táblázattá alakítod a listát. Ekkor már tudsz színre szűrni. A kiszűrt pirosakat átmásolod egy másik oszlopba (ennek is adsz címet), az A oszlopból pedig törlöd a tartalmukat.Az A-ban üres celláid lesznek, ezeket meg kell szüntetni. Kijelölöd A2-től az utolsó névig, Ctrl+g (Ugrás menü), Irányított, Üres cellák. Ez a tartomány üres celláit jelöli ki. Most a Ctrl és a számbillentyűzeten lévő mínusz hatására ezek a cellák kitörlődnek, az alattuk lévő, tartalommal bíró cellák feljebb kerülnek, folyamatos lesz az oszlop kitöltöttsége.
Az A oszlopban maradtak az egyik-, a másikba a másik listás adatok kerültek.
Fontos, hogy mindkét oszlopban lévő nevek a saját oszlopukban csak egyszer forduljanak elő. Ehhez az Adatok | Ismétlődések eltávolítása menüpontot használd.
Most kezdődhet az érdemi munka.
Kijelölöd a két tartományt, majd feltételesen formázod azokat. Új szabály, Csak az egyedi vagy az ismétlődő értékek formázása menüpont. Első esetben az ismétlődő opciót választod, és megadod a formátumot, OK. Következő lépésként beállíthatod az egyedi értékeket is, és másik formátumot adsz nekik.
Most már mindkét oszlopodat szűrheted szín szerint, és a szűrés eredményét (ismétlődő, vagy egyedi) átmásolhatod máshova, ha szükség van rá. -
Delila_1
veterán
Ha a beírt függvénnyel kész vannak a lapok, nem akarsz mást ellenőrizni, módosítani rajtuk, akkor a mostani makróba az End Sub fölé írd be egy új sorba annak a makrónak a nevét, amelyiket a mentésre kiválasztottad (LapMentes, vagy MentTorol).
Akkor elég a mostanit indítanod, minden feladatot elvégez. -
Delila_1
veterán
Van megoldás.
Sub Kulon_Lapra_2()
Dim sor As Long, lapnev As String, WS1 As Worksheet, usor As Long
Application.ScreenUpdating = False
Set WS1 = ActiveSheet
'egyedi rekordok az AA oszlopba
WS1.Range("B1:B" & Application.CountA(WS1.Columns(2))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
sor = 2
Do While Cells(sor, "AA") <> ""
lapnev = Cells(sor, "AA")
WS1.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=lapnev 'szűrés
Sheets.Add After:=Sheets(Sheets.Count) 'új lap létrehozása
ActiveSheet.Name = lapnev
WS1.Range("A1").CurrentRegion.Copy Sheets(lapnev).Cells(1) 'másolás
'képlet az U:W-be
usor = Application.WorksheetFunction.CountA(Columns(22)) + 1
Range("U" & usor & ":W" & usor) = "=subtotal(9,U2:U" & usor - 1 & ")"
WS1.Activate
sor = sor + 1
Loop
WS1.Range("A1").CurrentRegion.AutoFilter Field:=2 'szűrő visszaállítása
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
Akkor gyorsítsunk – bár úgy tapasztaltam, hogy sok sor esetén nem túl gyors az Excelben a szűrés.
A makró a B oszlop adataiból speciális szűréssel kimásolja az egyedi adatokat az AA oszlopba, onnan veszi, hogy milyen adatokra kell szűrni a tartományt. Ha az AA oszlopban vannak adataid, minden helyen írd át az AA-t nagyobb oszlop nevére.Az adatokat tartalmazó lapon állva kell indítani a makrót.
Sub Kulon_Lapra_1()
Dim sor As Long, lapnev As String, WS1 As Worksheet
Application.ScreenUpdating = False
Set WS1 = ActiveSheet
'egyedi rekordok az AA oszlopba
WS1.Range("B1:B" & Application.CountA(WS1.Columns(2))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
sor = 2
Do While Cells(sor, "AA") <> ""
lapnev = Cells(sor, "AA")
WS1.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=lapnev 'szűrés
Sheets.Add After:=Sheets(Sheets.Count) 'új lap létrehozása
ActiveSheet.Name = lapnev
WS1.Range("A1").CurrentRegion.Copy Sheets(lapnev).Cells(1) 'másolás
WS1.Activate
sor = sor + 1
Loop
WS1.Range("A1").CurrentRegion.AutoFilter Field:=2 'szűrő visszaállítása
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
3 makrót írtam. Az első sorra veszi a B oszlop celláit. Ha még nincs ennek megfelelő lap a füzetben, létrehozza, átmásolja a címsort és az aktuális sort. Az új lap neve az aktuális sor B oszlopában lévő adat lesz. Ha már van ilyen nevű lap, az első üres sorába másolja az aktuális sort. Nem kell az első lapon rendezettnek lennie a táblának.
A második sorra veszi a lapokat a másodiktól az utolsóig, Új füzetbe másolja az aktuális lapot, ezt elmenti a lapnév nevével az utvonal nevű változóban megadott mappába. Ezt a makró elején kell átírnod az
utvonal = "C:\Temp\"
sorban a saját mentési útvonaladra.Ha az eredeti füzetben nem akarod megtartani az újonnan létrehozott lapokat, akkor a második helyett a harmadik makrót futtasd. Ez nem másolja, hanem áthelyezi a lapokat 1-1 új füzetbe. Itt is át kell írnod az utvonal változó értékét.
A két másolós makró feltételezi, hogy kezdetkor 1 lap volt a füzetedben.
Sub Kulon_Lapra()
Dim sor As Long, lapnev As String, a, hova As Long, WS1 As Worksheet
Application.ScreenUpdating = False
Set WS1 = ActiveSheet
sor = 2
Do While Cells(sor, 1) <> ""
lapnev = Cells(sor, "B")
On Error Resume Next
Set a = Sheets(lapnev)
If Err.Number <> 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = lapnev
WS1.Rows(1).Copy Sheets(lapnev).Cells(1)
WS1.Activate
End If
On Error GoTo 0
hova = Application.WorksheetFunction.CountA(Sheets(lapnev).Columns(1)) + 1
Rows(sor).Copy Sheets(lapnev).Cells(hova, 1)
sor = sor + 1
Loop
Application.ScreenUpdating = True
End SubSub LapMentes()
Dim lap As Long, utvonal As String, lapnev As String
utvonal = "C:\Temp\"
Application.ScreenUpdating = False
For lap = 2 To Sheets.Count
lapnev = Sheets(lap).Name
Sheets(lapnev).Copy
ActiveWorkbook.SaveAs Filename:=utvonal & lapnev & ".xlsx"
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End SubSub MentTorol()
Dim lap As Long, utvonal As String, lapnev As String
utvonal = "C:\Temp\"
Application.ScreenUpdating = False
For lap = Sheets.Count To 2 Step -1
lapnev = Sheets(lap).Name
Sheets(lapnev).Move
ActiveWorkbook.SaveAs Filename:=utvonal & lapnev & ".xlsx"
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub -
#32527
Delila_1
veterán
customer114
#32524
Delila_1
veterán
válasz
customer114
#32524
üzenetére
Nem kell külön ellenőrizni, hogy a 4 HAHIBA eredménye nagyobb-e 0-nál. Ha bármelyik feltétel igaz, akkor a végeredmény is nagyobb lesz, ezért létrejön a színezés.
=HAHIBA(SZÖVEG.KERES("X";$B1);0)+HAHIBA(SZÖVEG.KERES("Y";$B1);0)+HAHIBA(SZÖVEG.KERES("Z";$B1);0)+HAHIBA(SZÖVEG.KERES("K";$B1);0) -
#32525
Delila_1
veterán
customer114
#32524
Delila_1
veterán
válasz
customer114
#32524
üzenetére
Bele.
=HAHIBA(SZÖVEG.KERES("X";$B1);0)+HAHIBA(SZÖVEG.KERES("Y";$B1);0)+HAHIBA(SZÖVEG.KERES("Z";$B1);0)>0Írd hozzá még a K-t.
Itt a végleges, K-val együtt.
=(HAHIBA(SZÖVEG.KERES("X";$B1);0)+HAHIBA(SZÖVEG.KERES("Y";$B1);0)+HAHIBA(SZÖVEG.KERES("Z";$B1);0)+HAHIBA(SZÖVEG.KERES("K";$B1);0))>0 -
#32523
Delila_1
veterán
customer114
#32522
Delila_1
veterán
válasz
customer114
#32522
üzenetére
-
#32521
Delila_1
veterán
customer114
#32518
Delila_1
veterán
válasz
customer114
#32518
üzenetére
=VAGY($B1="X";$B1="Y";$B1="Z")
Új hozzászólás Aktív témák
- Milyen videókártyát?
- Információbiztonság, kiberbiztonság, adatvédelem
- Formula-1
- Autós topik
- Project Motor Racing-Straight4 Studios
- Stratégiai biztonsággal védekeznek a dráguló memóriák ellen a gyártók
- Kínai és egyéb olcsó órák topikja
- Pulzust is mér az Apple AirPods Pro 3
- Szemüveges topik
- 5.1, 7.1 és gamer fejhallgatók
- További aktív témák...
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- BLACK FRIDAY! - Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Keresem a Barkács Balázs Játékokat
- Lenovo Thinkpad 13 G2 Intel i3-7100 laptop (hiányos, de működik)
- GYÖNYÖRŰ iPhone 13 Pro 256GB Sierra Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS3358, 100% Akkumulátor
- Általános igazgatóhelyettes tábla üvegből eladó
- Intel Core i5 3470 confidential Ivy bridge Quad Core
- HIBÁTLAN iPhone 13 mini 128GB Starlight -1 ÉV GARANCIA -Kártyafüggetlen, MS3614, 100% Akkumulátor
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi