-
Fototrend
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
-
Fferi50
Topikgazda
válasz
gycs02
#52875
üzenetére
Szia!
Próbáld ki esetleg ezeket:Sub Lathatoba_xV1()Dim elso As Integer, utolso As Integer, srng As Range, cl As Rangeelso = 13 ' Ide azt a számot írd, ahol a szűrés kezdődikutolso = Range("A" & Rows.Count).End(xlUp).RowSet srng = Range("A" & elso & ":A" & utolso) ' ha nem összefüggő a szűrt terület, cellánként kell végigmenni sajnos.For Each cl In srng.Columns(1).SpecialCells(xlCellTypeVisible).Cellscl.Value = "x"NextEnd SubSub masolo_V1()Dim elso As Integer, utolso As Integer, srng As Rangeelso = 13utolso = Range("A" & Rows.Count).End(xlUp).RowSet srng = Range("A13:A" & utolso)srng.SpecialCells(xlCellTypeVisible).CopyWith Sheets("Munka2").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths 'bemásoljuk az oszlopszélességet0.PasteSpecial Paste:=xlPasteValuesAndNumberFormats 'majd az értéket és a számformátumotEnd WithApplication.CutCopyMode = FalseEnd Sub
Üdv. -
Delila_1
veterán
válasz
gycs02
#52875
üzenetére
Sub Lathatoba_x()Dim elso As Integer, utolso As Integerelso = Range("A13:A1000").SpecialCells(xlCellTypeVisible).Rowutolso = Range("A" & Rows.Count).End(xlUp).RowIf elso = utolso ThenRange("A" & elso) = "x"ElseRange("A" & elso & ":A" & utolso).SpecialCells(xlCellTypeVisible) = "x"End IfEnd SubSub masol()Dim elso As Integer, utolso As Integerelso = Range("A13:A1000").SpecialCells(xlCellTypeVisible).Rowutolso = Range("A" & Rows.Count).End(xlUp).RowIf elso = utolso ThenRange("A" & elso).Copy Sheets("Munka2").Range("A1")ElseRange("A13:A1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Munka2").Range("A1")End IfEnd Sub
Új hozzászólás Aktív témák
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- MS SQL Server 2016, 2017, 2019
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- ÁRGARANCIA!Épített KomPhone i7 14700KF 32/64GB RAM RTX 5070 Ti 16GB GAMER PC termékbeszámítással
- HIBÁTLAN iPhone 15 Pro 128GB Blue Titanium-1 ÉV GARANCIA - Kártyafüggetlen, MS4692, 92% AKKSI
- Licencek + laptopok + dokkolók
- ÁRGARANCIA! Épített KomPhone Ultra 9 285K 64GB RAM RX 9070 XT 16GB GAMER PC termékbeszámítással
- Új Asus Vivobook S16 Flip 2in1 WUXGA X360 Touch i9-13900H 14mag 16GB 1TB SSD Intel Iris XE Garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50