Szia!

Ez a makró az első 6 oszlopot figyeli. Az A oszlophoz tartozó beviteli dátumot a G-be írja, a B dátumát a H-ba, és így tovább.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column < 7 Then
        Application.EnableEvents = False
        Cells(Target.Row, Target.Column + 6) = Date
        Application.EnableEvents = True
    End If
End Sub

Delila

=2025-1981
🙂

Szia Robin!

Az első név melletti oszlopba beírod a teljes név utolsó keresztnevét. Kijelölöd ezt, és az alatta lévő cellákat, a neveket tartalmazó oszlop végéig. Kezdőlap, Szerkesztés, Villámkitöltés.
Csodák csodája, minden cellában megjelenik az utolsó keresztnév. Ekkor már egyszerű a dolog, a férfiak lapon lévő neveket kell figyeltetni.
=HA(DARABHA(férfiak!A:A;B2)>0;"férfi";"nő")
(Az első teljes név az A2 cellában van, ebből az utolsó keresztnév a B2-ben)

A neveket Verax füzetéből plagizáltam, de csak a férfiakat.

Delila

Szórakoztam egy kicsit. Most már táblázatban akárhány kaja értéket lekérdezheted, egymás alatt (S:Y táblázat).
Az érvényesítéshez új táblázatot hoztam létre az AA oszlopban. Ezt módosítva, bővítve változik az érvényesség.

Az S oszlopban csak ki kell választanod az új kaját, a tábla többi oszlopa automatikusan kitöltődik.

Szia!

Vegyél fel 3 új cellát. Az első a megtalált kaja sorát adja, képlete:
=HAHIBA(HOL.VAN($S$7;Táblázat1[gabona];0);0)+HAHIBA(HOL.VAN($S$7;Táblázat2[gyümölcs];0);0)+HAHIBA(HOL.VAN($S$7;Táblázat3[zöldség];0);0)

A második megmutatja, hogy a 3 tartomány közül melyikben található a kaja, képlete:
=HA(DARABHA(Táblázat1[gabona];$S$7)<>0;1;HA(DARABHA(Táblázat2[gyümölcs];$S$7)<>0;2;HA(DARABHA(Táblázat3[zöldség];$S$7)<>0;3)))

A harmadik adja meg a kódot, képlete:
=INDEX((Táblázat1[áru kódja];Táblázat2[áru kódja];Táblázat3[áru kódja]);E13;;E14)

A két elsőt el is rejtheted.

Szia!

A B1:R9999 feltételes formázásának a képlete legyen
=ÉS(NEM(ÜRES(B1));DARABHA($A$1:$A$50;B1)=0)
Delila

Ha most még az is kiderül, hogy a számok nem az A oszloptól kezdődnek, sírva fakadok.
Ha viszont így van, tedd a táblázatod végére azokat az oszlopokat, amelyek nem a számokat tartalmazzák (pl. dátumokat). Máskülönben újra kezdhetném a makró átírását.

Sikerült kijavítani a hibát (éjjel megálmodtam).

A Module1 52. sorában a képletnél nem tudom, hogy lehet változóban megadni a tartomány utolsó oszlopát, így fixen írtam be 10-re.
Range(„A2”).FormulaR1C1 = „=COUNTIF(Adatok!RC1:RC10,Elemzés!R1C)”

Ehhez meg kell adnod a 2 lap nevét,
melyik lapon vannak az adatok,
melyik oszlopokban,
hányadik sorban kezdődnek,
melyik lapon és melyik tartományban szeretnéd látni az eredményeket.

D.

:))

Szia Verax!

A füzeted verax lapján a =HA(HA(L2<>0;SOR();0)<>0;HA(L2<>0;SOR();0)-MAX(M$1:M1);"") képletet kiegészítettem egy -1-gyel:
=HA(HA(L2<>0;SOR();0)<>0;HA(L2<>0;SOR();0)-MAX(M$1:M1)-1;""), mert a 0-kat tartalmazó sorokat kell számlálni.

Én más megoldást – makróst – próbáltam. Csatolom a füzetet. Az üres (1-est nem tartalmazó) sorok számát az M oszlopba írja, egymás alá.

Üdv, Delila

Szia!

Sub Valogatas()
    Dim CV, sor As Integer
    sor = 3
    For Each CV In Range("C3:F7")
        If CV.Value > "" Then
            Range("H" & sor) = CV
            sor = sor + 1
        End If
    Next
End Sub

Szia!

Makróval meg lehet oldani. Lapfülön jobb klikk, Kód megjelenítése. Ezzel bejutsz a VB szerkesztőbe. A jobb oldali üres lapra másold be:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        On Error Resume Next
        Range(Target.Address).Select
        Selection.TextToColumns Destination:=Range(Target.Address), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, Semicolon:=True, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
            TrailingMinusNumbers:=True
        On Error GoTo 0
    End If
End Sub

Mikor beviszed az A oszlop egy cellájába az adatokat, indul a makró, és szétválasztja a QR kódokat az aktuális sor celláiba.
A füzetet makróbarátként kell mentened.

OK.

Szia!

Úgy látom, az utolsó szám után is van vessző, így a vesszők száma megadja a számok darabszámát.
Az A1-ben a vesszőket meg tudod számlálni.
=HOSSZ(A1)-HOSSZ(HELYETTE(A1;”,”;””))

Üdv,
Delila

A Kimutatás 2024 lapon az általad küldött összegző képletek helyett az E oszlopba írtam be egy másikat, ezzel már OK.

Szerk.: az E oszlopot formázhatod. A teljes oszlopra ne legyen szegély, majd E3-tól lefelé A formázandó cellák kijelölése képlettel pontnál a képlet legyen =HOSSZ(E3)>0, a formátum pedig körbe keretezve.

Szia!

Itt sok ember jár és válaszol, nem egy. Úgy szokás megoldani az adatok nyilvánosságtól való megmentését, hogy létrehozol egy új füzetet, és abban hamis adatokat közölsz (a képleteiddel együtt). Csupán arra ügyelj, hogy az eredetinek megfelelő típusú adatokat adj meg – dátum, szám, szöveg. Ezt már gond nélkül belinkelheted.

Üdv,
Delila

Sziasztok!

Csatolok egy másik megoldást, amit Krizsák László alkotott anno, én csak itt-ott piszkáltam bele.
A Fájl címe nem az igazi, de attól még prímán működik.

Üdv,
Delila

Szia!

A Beállítások, Speciális lapon „Az Enter lenyomására a fókusz áthelyezése” legyen jobbra.
A lapodon jelöld ki az oszlopokat, ahova írhat a felhasználó (nincsenek képletek).
Cellaformázás, Védelem fül, a Zárolás elől vedd ki a pipát.
Adj védelmet a lapnak (lapfülön jobb klikk, Lapvédelem), a Zárolt cellák kijelölése elől vedd ki a pipát. Adhatsz jelszót is, de nem fontos.

Delila

Email-ben?
Szívesen.

Szándákosan értékeket másoltam a Feladat lapra, a sok képlet lassítja a futást (sok sornál).
Egy hiba is volt a makrómban, a Csoport (2) oszlopba az 5. sortól vittem be a Munka2 lap adatait.
A mostani makróban csak az F (Fűz) oszlopban vannak képletek, hogy megmutassam, miként lehet tartományba képleteket bevinni.
Ezt a makrót is meghívhatod a lapjaidról az adatok változásakor.

Sub Masolas()
    Dim tabla As Range, usor As Integer, ide As Integer
    
    Sheets("Feladat").Select
    Range("C5:H1500").ClearContents  'előző adatok törlése
    
    Sheets("Munka1").Select     'Értékek másolása a Munka1 lapról
    usor = Range("B5").End(xlDown).Row
    Range("B5:B" & usor).Copy
    Range("C5").PasteSpecial xlPasteValues
    Range("B5:C" & usor).Copy
    Sheets("Feladat").Range("C5").PasteSpecial xlPasteValues
    Range("F5:F" & usor).Copy
    Sheets("Feladat").Range("E5").PasteSpecial xlPasteValues
    
    ide = Sheets("Feladat").Range("C" & Rows.Count).End(xlUp).Row + 1
    Sheets("Munka2").Select     'Értékek másolása a Munka2 lapról
    usor = Range("B5").End(xlDown).Row
    Range("B5:B" & usor).Copy
    Range("C5").PasteSpecial xlPasteValues
    Range("B5:C" & usor).Copy
    Sheets("Feladat").Range("C" & ide).PasteSpecial xlPasteValues
    Range("G5:G" & usor).Copy
    Sheets("Feladat").Range("F" & ide).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    Sheets("Feladat").Select
    usor = Range("C" & Rows.Count).End(xlUp).Row    'összefűző képlet a Fűz oszlopba
    Range("G5:G" & usor) = "=E5 & F5"
End Sub

Szívesen. 🙂

Szia!
Írtam egy makrót.

Sub osszefuzes()
    Dim sor As Integer, szoveg As String
    sor = 2
    
    Do While Cells(sor, 1) <> ""
        If Cells(sor, 1) <> Cells(sor - 1, 1) And Cells(sor, 1) <> Cells(sor + 1, 1) Then
            Cells(sor, 3) = Cells(sor, 2): sor = sor + 1
        End If
        If Cells(sor + 1, 1) = Cells(sor, 1) Then
            If szoveg = "" Then szoveg = Cells(sor, 2)
            szoveg = szoveg & "]-[" & Cells(sor + 1, 2)
        Else
            Cells(sor, 3) = szoveg
            szoveg = ""
        End If
        sor = sor + 1
    Loop
End Sub

Alt+F11-re bejön a VB szerkesztő. Itt beszúrás (insert), modul (module). A jobb oldalon kapott üres felületre bemásolod a makrót. Makróbarátként kell elmentened a füzetet.

A jobb áttekinthetőség kedvéért minden azonosítónál csak az alsó sorba írattam ki az eredményt.
Indítás a füzetben: az Alt+F8-ra megjelenő ablakban indítod az osszefuzes nevűt.

Üdv,
Delila

Szia!

A képen (is) láthatod a képletet.
=HA(NEM(HIBÁS(SZÖVEG.KERES("út";A1)));KÖZÉP(A1;SZÖVEG.KERES("út";A1)+3;20);HA(NEM(HIBÁS(SZÖVEG.KERES("u.";A1)));KÖZÉP(A1;SZÖVEG.KERES("u.";A1)+3;20);HA(NEM(HIBÁS(SZÖVEG.KERES("tér";A1)));KÖZÉP(A1;SZÖVEG.KERES("tér";A1)+4;20);HA(NEM(HIBÁS(SZÖVEG.KERES("utca";A1)));KÖZÉP(A1;SZÖVEG.KERES("utca";A1)+5;20);KÖZÉP(A1;SZÖVEG.KERES("köz";A1)+4;20)))))

Bocsáss meg, „csak” a lényeget nem írtam meg. A makrót ahhoz a laphoz kell rendelned, ahol működtetni akarod.
Lapfülön jobb klikk, Kód megjelenítése. Ezzel bejutsz a VB szerkesztőbe, ott is a lapod lesz kiválasztva. Jobb oldalon a nagy üres felületre másold a makrót.
A Module1-et törölheted.

Biztosan jó a „D:\D:\NIN\Excel_tippek\PDF_gyujto\” útvonal? Kétszer szerepel a meghajtó neve.

Szia!

Legyen a cellaformátum hh.nn, majd rendezd az oszlopot. Visszaállíthatod a formátumot éé.hh.nn-ra.
A kérdésnek a második részét nem értem.

Delila

Még egyszerűbb stoppolás:
A Sub sornál a bal oldalon lévő szürke sávra kattintasz. A teljes sor barna hátterű lesz, és csak akkor halad tovább a makró futása, ha F8-at nyomsz.

Szia!

Több leírást adtál a feladatra, én erre írtam egy makrót:
Az “A” oszlop kitöltése után, a “B” oszlopban beállítom – számszerűsítve ( 0-3 , vagy ha a 0 nem értelmezhető, akkor 1-4 ig – , hogy a “C” oszlophoz képest mennyivel tolja el és írja ki az “A” oszlopban szereplő szöveget.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 And Cells(Target.Row, 1) <> "" And IsNumeric(Target) Then
        Application.EnableEvents = False
        Cells(Target.Row, 3 + Target.Value) = Cells(Target.Row, 1)
        Application.EnableEvents = True
    End If
End Sub

Beírod az A oszlopba a szöveget. Mikor az azonos sor B oszlopában megadod az eltolás mértékét, a C-hez képest annyi oszloppal jobbra is megjelenik az A oszlop szövege.
A makrót a lapodhoz kell rendelni. Lapfülön jobb klikk, Kód megjelenítése. Ezzel belépsz a VB szerkesztőbe. A jobb oldalon lévő üres mezőbe bemásolod a fent megadott makrót.

Delila

Szia!

Meg lehet írni, de szerintem sokkal egyszerűbb a 3 oszlopra feltételes formázást adni, ami feltűnő háttérszínt ad a kitöltetlen celláknak.

Üdv
Delila

Szia!

Ha az adatrendezést úgy érted, hogy a Munka1 lap kikeresett értékeit beírod a Munka2 lap megfelelő soraiba, ill. oszlopaiba, akkor ezt javaslom:

Sub Ciklus()
    Dim tol As Integer, ig As Integer, ide As Integer, keres As Integer
    Sheets("Munka1").Select
    
    ide = 0
    For keres = 20 To 2500 Step 50
        tol = keres: ig = keres + 50
        ide = ide + 1
        FKeres tol, ig, ide
    Next
End Sub

Sub FKeres(tol, ig, ide)
    Sheets("Munka2").Cells(ide, 1) = Application.WorksheetFunction.VLookup("X", Range("P" & tol & ":Q" & ig), 2, 0)
    Sheets("Munka2").Cells(ide, 2) = Application.WorksheetFunction.VLookup("Y", Range("P" & tol & ":Q" & ig), 2, 0)
    Sheets("Munka2").Cells(ide, 3) = Application.WorksheetFunction.VLookup("Z", Range("P" & tol & ":Q" & ig), 2, 0)
End Sub

A VLOOLUP a P:Q tartományban keres, a Q értékét adja vissza.

Delila

Gyorsan írtam minden sorhoz magyarázatot a makróban. Feltöltöm az új verziót. Egy kicsit egyszerűsítettem a makrón.

Részemről szívesen. 🙂

Kedves egészségedre!

A Korábbi időpont és a Későbbi időpont címekhez összevontad a cellákat. Beírod a B1-be a szöveget, majd kijelölöd a B1:D1 tartományt. A cellaformázásnál a vízszintes elrendezésnél a Kijelölés közepére opciót választod.

A szorzások azért kellenek, mert a jobb, bal és közép függvények eredménye szöveg, de ha felszorozzuk 1-gyel, vagy hozzáadunk nullát, számként értelmezi az Excel a továbbiakban.

Csak az első két, adatokat tartalmazó sort formáztam.

Jogos a két pont!
Ezt elnéztem.

Mikor az első makrót tettem be ide, ezt írtam: Az A oszlopod ne legyen zárolt.
Neked kell a lap zárolása előtt az írható oszlopok védelmének a megszüntetése.

Átírtam a makrót.
Kérlek, tiszteld meg a fórumot azzal, hogy a hozzászólás elküldése előtt átnézed az írásodat, és csak a hibák kijavítása küldd azt el.
Nem tudok mit kezdeni az ilyen sorokkal: Tudom bocsolult a kérésem, de talán megoldható.

Teszt?! 🙂
Szívesen.

Mese a csatolt fájlban.

Remek!

Szívesen.

Nézd meg újra a makrót, amit küldtem, és csak ott változtass, ahol a megjegyzésekben írtam.

Szia!

A feladattól függ a megoldás.
A munkalap ScollArea tulajdonságához beírtam: $A:$C
Ezzel elértem, hogy lapvédelem nélkül csak az első 3 oszlopba lehet kattintani. Egy makró megadja, hogy a C oszlopba beírt adattal (jelenleg számmal) történjen a D oszlopban egy művelet, amit a makró által előállított képlet hajt végre.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 Then
        Application.EnableEvents = False
        Cells(Target.Row, 4) = "=3*" & Target.Value
        Application.EnableEvents = True
    End If
End Sub

Delila

Azt hiszem, addig már eljutottál, hogy az M oszlopban vannak az adatok, amik számjegyeket, és max 1 db kötőjelet tartalmaznak. Az L oszlopban azok az adatok vannak, amiknek az első 3 karakterét kell a kötőjelek helyére tenni az M-ben.
A lenti makró az O oszlopba ír egy képletet, ami létrehozza az általad kívánt eredményt. Ezt értékként beilleszti az M oszlopra, az ideiglenes O oszlopot törli.

Sub Segedoszlop_O()
    Range("O2:O15").FormulaR1C1 = _
        "=IFERROR(LEFT(RC[-2],SEARCH(""-"",RC[-2])-1)&LEFT(RC[-3],3)&RIGHT(RC[-2],LEN(RC[-2])-SEARCH(""-"",RC[-2])),RC[-2])"
    Columns(15).Copy
    Range("M1").PasteSpecial xlPasteValues
    Columns(15).Delete
End Sub

Igazad lehet. Megeshet, hogy például „\,” szerepel némelyik cellában. Az összes adat ismeretében meg kell találnod a helyes sorrendet.

Igazad van, gyorsabb a REPLACE függvénnyel.

Sub CsereBere()
    Dim ido As Date
    
    usor = Range("M" & Rows.Count).End(xlUp).Row
    
    Range("M1:M" & usor).Replace What:=",,,,,,,,", Replacement:=","
    Range("M1:M" & usor).Replace What:=",,,", Replacement:=","
    Range("M1:M" & usor).Replace What:=",,", Replacement:=","
    Range("M1:M" & usor).Replace What:="_", Replacement:=","
    Range("M1:M" & usor).Replace What:="-", Replacement:=","
    Range("M1:M" & usor).Replace What:="\", Replacement:=","
    Range("M1:M" & usor).Replace What:="/", Replacement:=","
    Range("M1:M" & usor).Replace What:=" ", Replacement:=","
    MsgBox Format(Now - ido, "mm:ss")
End Sub

Nem tudom, miért nem enged simán másolni, de a txt beiktatásával klassz megoldás. Köszönöm.

Szia!

Az A oszlop tartalmát átmásoltam a G-be, majd az Ismétlődések eltávolítása funkcióval kitöröltem a felesleges sorokat. A H oszlop tartalmazza a beírandó szövegeket. Az új tartomány a G1:H32. A C oszlopba írtam a képletet.

Delila

Szia!

Két példa az első üres sor meghatározására, jelenleg az A oszlopban.

Sub ElsoUres()
    Dim usor As Long
    usor = Range("A" & Rows.Count).End(xlUp).Row + 1
    MsgBox usor
    
    usor = Application.WorksheetFunction.CountA(Columns(1)) + 1
    MsgBox usor
End Sub

Innen már be tudod vinni az adatot, pl. cells(usor, 1)= …
Nem jelent meg a táblázatod. Valószínűleg makróbarát füzetet akartál belinkelni, de ez a fórum csak tömörítetten fogadja el.

Szia!

A címsor ne legyen zárolt.
Tedd ki a gyorselérési eszköztárra az autoszűrő ikonját (tölcsér alakú), erre kétszer kattintva megoldódik a gondod.
Az első kattintás megszünteti a szűrőket a címsorban, a második visszateszi a már szűretlen tartományhoz.

Üdv,
Delila

Indítod a makrót. Mikor leáll a hibaüzenettel, Alt+F11-gyel belépsz a VB szerkesztőbe. A kurzort a hibás sorban (sárga hátterű) a sor változó fölé viszed, ami megmutatja a hibás sor számát. Azzal már tudsz valamit kezdeni. Leállítod a makrót (az eszköztáron a négyszögletes stop gombbal), majd a füzetben a Riport_2 lapon kikeresed azt a sort.
El tudom képzelni, hogy valamelyik hónapban az összeg nem szám, hanem számnak látszó szöveg.

Vagy: tömöríted a fájlodat, és beteszed ide.