Hirdetés
- One mobilszolgáltatások
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Nagyon jól néz ki a Nothing Phone (3a) limitált kiadása
- Fele annyit ér az iPhone Air, mint amennyibe pár hete került
- Minimális változásokat hozhat a Google Pixel 10a
- Apple iPhone Air - almacsutka
- Google Pixel topik
- Google Pixel 8 Pro - mestersége(s) az intelligencia
- Xiaomi 14T Pro - teljes a család?
- Samsung Galaxy Watch4 és Watch4 Classic - próbawearzió
-
Mobilarena
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
-
Excelbarat
tag
válasz
sarvari
#17013
üzenetére
Hi!
Igazából nagyon nem akartam elbonyolítani így a makró a vastagság és szélesség oszlopokat tölti fel a súly értéket pedig függvénnyel már meg lehet oldani.
1. lépés Beírod ugyan arra a munkalapra a fejléceket pl A11: Név, B11: Szám, C11:Vastagság, D11: szélesség
2. makrót elindítod. Működése: a vastagság értékeket beírja annyiszor egymás alá ahány szélesség van. (megkeresi adott esetben C oszlop legalsó értékét és az alá tölti, ezért kell C,D11-be pl beírni a fejlécet, mert az a mérvadó). Majd a szélesség értékeket transzponálja D oszlopba egymás alá addig amíg C oszlopban van érték.
3. a Súly oszlopba beírod ezt a képletet és végigmásolod (katt a jobb alsó sarkában lévő kis fekete pöttyre 2x)
=INDEX($A$5:$D$8;HOL.VAN(C12;$A$5:$A$8);HOL.VAN(D12;$A$5:$D$5)) a te példád szerint vannak a hivatkozások! a dollár jelekre figyelj!
4. makrót törölheted így nem kell makróbarát fájlként elmentened.Futtatás előtt egy másolati példányon teszteld mert makró általi módosításokat nem lehet visszavonni!
Íme a makró:
Sub tolt()
Dim darab
Dim kezd
Dim ertek
darab = 3 - 1
'3-at módosítsd, hogy hány db szélesség érték van(a példádban 10,20,30 tehát 3)!
For i = 6 To 8
'Vastagság kezdő(6) és végső(8) értékének sorszámait módosítsd!
ertek = Cells(i, "A").Value 'A oszlop i sorait írja be megadott számszor az új táblába
kezd = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
Range(Cells(kezd, "C"), Cells(kezd + darab, "C")).Value = ertek
Next i
'vastagság oszlop feltöltve
Range(Cells(5, "B"), Cells(5, "D")).Copy 'módosítsd a szélesség adatok kezdő és végső oszlopát
kezd = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
Do While Cells(kezd, "C").Value <> ""
Cells(kezd, "D").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
kezd = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
Loop
Application.CutCopyMode = False
'feltöltve a szélesség oszlop
End Sub
Alkalmazása: jobb gomb a lapfülre kód megjelenítése oda bemásolod és F5-tel elindítod (vagy felül a zöld play ikonra katt)
A név és a szám értékeket pedig = jellel végigmásolod. -
Excelbarat
tag
válasz
sarvari
#17000
üzenetére
Hi!
Írok rá egy makrót ha megadsz pár adatot:
Vastagság értékei mettől meddig helyezkednek el: pl. amit fényképeztél ott: A6-A8 ig
Szélesség értékei mettől meddig vannak és hányadik sor: pl:5. sor B-D
Név: Cellája(B1)
Szám: Cellája(B2)
és hogy hova kerüljön az új tábla. (Gondolom fejléceket már beírtad
)
Új hozzászólás Aktív témák
- Ingyen és modern rendszerekre szánva tér vissza az Unreal Tournament 2004
- Most már tényleg itt az Ítéletnap, premier előzetesen a Terminator 2D: NO FATE
- Milyen széket vegyek?
- One mobilszolgáltatások
- Samsung Galaxy Felhasználók OFF topicja
- exHWSW - Értünk mindenhez IS
- Le Mans Ultimate
- Visszaengedi Kínába az NVIDIA H200-at a Trump-adminisztráció
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Allegro vélemények - tapasztalatok
- További aktív témák...
- Játékkulcsok : ! Legjobb Áron ! : PC Steam, EA App, Ubisoft, Windows és egyéb játékok : (12.11.)
- 10 Darab ÚJ PC Játékszoftver
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most Ünnepi áron! :)
- Antivírus szoftverek, VPN
- magyar billentyűzet - 172 - Lenovo Legion Pro 7 (16IAX10H) - Intel Core U9 275HX, RTX 5080
- Intel Core i5 4440 4mag 4szál processzor garanciával hibátlan működéssel
- HP EliteBook 840 G9 i7-1265U 16GB 512GB 14" FHD+ 1 év teljeskörű garancia
- GeForce RTX 4060 (OEM HP) Garanciával
- Dell Alienware AW3423DW 34 QD-OLED Gaming Monitor 27% ÁFÁS
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: ATW Internet Kft.
Város: Budapest
)
Fferi50

