Hirdetés
- Send to qBittorrent (with SavePaths): Egy apró Firefox kiegészítő qBittorrenthez
- Ikea PAX gardrób és a pokol logisztikája – egy Ikea-horror igaz története
- -TongFang- Medion Erazer Beast 16 X1 - induló teszt így kora délután..."CB R23"
- Pi-hole és a Telekom Sagemcom F@st 5670 DNS beállítása
- A Magyar Néphadsereg emlékére
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- GoodSpeed: A RAM-válság és annak lehetséges hatásai
- Magga: PLEX: multimédia az egész lakásban
- Luck Dragon: Asszociációs játék. :)
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- D@reeo: Pi-hole és a Telekom Sagemcom F@st 5670 DNS beállítása
- Ketogén étrend
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- [K2]: AnyDesk átverés
-
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
-
Pikkolo^^
addikt
-
válasz
Pikkolo^^
#34846
üzenetére
Kifutottam a szerkesztésből - bonyolultabb (segédoszlopos) megoldás:
1) Sárga terület TEXT formtumra konvertálása, utána szabadon tölthető (sajnos a lenti formula nem kezeli jól a szám és dátum formátumoú adatokat). B1 kötelezően üres marad.2) Zöld első mezőbe (B2) a következő Array formula kell (CTRL+ENTER - rel kell bevinni):
=IFERROR(INDEX($A$2:$A$11,MATCH(0,COUNTIF($A$2:$A$11,"<"&$A$2:$A$11)-SUM(COUNTIF($B$1:B1,$A$2:$A$11)),0)),"")3) Első zöld mezőt lehúzni a sárga aljáig
4) A következő Named Range felvétele (itt pl. Validation névvel):
=OFFSET(Sheet1!$B$2,0,0,COUNTIF(Sheet1!$B$2:$B$11,">'"),1)5) Validáláshoz a fenti Named Range behivatkozása:
-
-
-
Fferi50
Topikgazda
válasz
Pikkolo^^
#32160
üzenetére
Szia!
Igen, meg kell nyitnod hozzá a Word alkalmazást az Excel makróban, abba kreálni egy új dokumentumot és az Excel tartalmat belemásolod.
Sub wordos()
Dim wrd As Object, wd As Document
Set wrd = CreateObject("word.application") 'Word nyit
wrd.Visible = True
Set wd = wrd.documents.Add 'új dokumentumot nyit
ActiveSheet.UsedRange.Copy 'kijelölöd a másolandó területet (pl. Range("A1:F25")
wrd.Selection.Paste 'ha képként szeretnéd beilleszteni, akkor PasteSpecial, paraméterekkel HELP segít
wrd.Activate
wd.Save 'itt meg kell adnod, hogy milyen néven mented
wrd.Quit ' Word bezár
End SubFigyelem! A makró futtatása előtt a VBA ablak Tools Menüjében a References menüpontban be kell jelölnöd a megfelelő Microsoft Word könyvtárat!!! (pl. 2016-os nál Microsoft Word 16.0 Object Library).
Üdv.
-
bsasa1
csendes tag
-
Delila_1
veterán
válasz
Pikkolo^^
#32149
üzenetére
Nem látszanak a sor- és oszlopazonosítók a képen.
Modulba tedd a makrót.
Sub Kigyujtes()
Dim sor As Long, oszlop, ide As Long
sor = 3
Do While Cells(sor, "B") <> ""
oszlop = Application.Match(Cells(sor, "C"), Rows(2), 0)
If VarType(oszlop) = vbError Then
MsgBox "Nincs " & Format(Cells(sor, "C"), "yyyy.mm.dd") & " dátum a 2. sorban"
Else
ide = Cells(Rows.Count, oszlop).End(xlUp).Row + 1
Cells(ide, oszlop) = Cells(sor, "B")
End If
sor = sor + 1
Loop
End SubNézd meg a képen, hogy a keresendő dátumokat tartalmazó sor feljebb van, mint a C oszlop első dátuma, ez fontos.
-
Új hozzászólás Aktív témák
Fferi50- Xbox tulajok OFF topicja
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Anglia - élmények, tapasztalatok
- LEGO klub
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- Kutya topik
- Milyen okostelefont vegyek? OFF topik
- MIUI / HyperOS topik
- Black Friday november 29. / Cyber Monday december 2.
- Elemlámpa, zseblámpa
- További aktív témák...
- Stalker Clear Sky Limited Collector's Edition
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- PC Game Pass előfizetés
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Bomba ár! HP EliteBook 840 G7 - i7-10510U I 16GB I 256SSD I HDMI I 14" FHD I Cam I W11 I Gari!
- Eladó Honor X7a 4/128GB Kék / 12 hónap jótállással!
- OUKITEL G1 Mobiltelefon 24/256Gb dupla sim
- ÚJ ELEKTROMOS ROLLER Black friday Hardverapró.húúú!!! 2/3 ár alatt a és e-bike dobozban, 1 év gar.:
- Fujitsu LIFEBOOK E449 i3-8130U 12GB 512GB 14" FHD 1 év garancia
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi