Hirdetés
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Luck Dragon: Asszociációs játék. :)
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- sziku69: Fűzzük össze a szavakat :)
- Brogyi: CTEK akkumulátor töltő és másolatai
- sziku69: Szólánc.
- potyautas: Másik küldetés
- [K2]: AnyDesk átverés
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- Elektromos rásegítésű kerékpárok
-
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
-
m.zmrzlina
senior tag
válasz
tgumis
#24223
üzenetére
Ennél a sornál az idézőjelbe annak a munkalapnak a nevét írod amelyikre az eredményt másolni szeretnéd.
Set eredmeny = ThisWorkbook.Worksheets("eredmeny")Itt is kijavítod az eredmeny-t a munkalap nevére és ha nem az A
tartományba akarod kiiratni az eredményt azt is megváltoztathatod (lényeg, hogy 4 oszlopnyi tartományt adj meg)
eredmeny.Range("A1:D" & j).Value = Application.Transpose(tomb)Option Base 1
Sub nagyobbnulla()
Dim tomb()
ReDim tomb(4, 1)
Set eredmeny = ThisWorkbook.Worksheets("eredmeny")
j = 1
For Each ws In Worksheets
For Each cella In ws.Range("AO1:AO49")
If cella.Value > 0 Then
For i = 1 To 4
tomb(i, j) = ws.Cells(cella.Row, cella.Column - (4 - i)).Value
Next
ReDim Preserve tomb(4, j + 1)
j = j + 1
End If
Next
Next
eredmeny.Range("A1:D" & j).Value = Application.Transpose(tomb)
End Sub
Új hozzászólás Aktív témák
- OpenWRT topic
- Hat év támogatást csomagolt fém házba a OnePlus Nord 4
- Milyen monitort vegyek?
- Formula-1
- Feketelista, avagy a rossz boltok topicja
- Milyen routert?
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Android szakmai topik
- Az AI-piac kivégezte a Micronhoz tartozó Crucialt
- Proxmox VE
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- PC Game Pass előfizetés
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- BESZÁMÍTÁS! Asus TUF Z690 i7 14700KF 32GB DDR5 1TB SSD RX 6900XT 16GB Zalman Z1 PLUS EVGA 850W
- ÁRGARANCIA!Épített KomPhone Ryzen 5 7500F 32/64GB RAM RX 7800 XT 16GB GAMER PC termékbeszámítással
- Xiaomi Redmi 13 4G 256GB, Kártyafüggetlen, 1 Év Garanciával
- ÚJ Razer Kraken V4 Pro gamer fejhallgató
- ÁRGARANCIA!Épített KomPhone Ryzen 5 4500 16/32/64GB RAM RTX 3060 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
tartományba akarod kiiratni az eredményt azt is megváltoztathatod (lényeg, hogy 4 oszlopnyi tartományt adj meg)
Fferi50
