Hirdetés
- GoodSpeed: Márkaváltás sok-sok év után
- GoodSpeed: A RAM-válság és annak lehetséges hatásai
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- Luck Dragon: Asszociációs játék. :)
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- eBay-es kütyük kis pénzért
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Gurulunk, WAZE?!
- Mr Dini: Mindent a StreamSharkról!
-
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
-
Delila_1
veterán
válasz
zz76zz
#14942
üzenetére
Eléggé dodonai módon fogalmaztál. Van egy oszlop cikkszámokkal... Hol van az az oszlop?
Írtam egy makrót, ahol a Munka1 lap A oszlopában van a cikkszám, az első sorban a dátumok. A cikkszámok sorában, a fenti dátumok oszlopában az aznap rendelt mennyiségek.
Ezekből az adatokból készít a makró egy új táblázatot a Munka2 lapon, ahol az A oszlop a cikkszámot tartalmazza, a B a dátumot, a C pedig a rendelt mennyiséget. Azokat a napokat, mikor nem volt a cikkszámhoz tartozó rendelés, kihagyja.
Ha nem ilyent szerettél volna, magadra vess a homályos fogalmazás miatt.
Sub valami()
Dim sor%, usor%, oszlop%, uoszlop%, WS As Worksheet
Dim sorW%, cikksz, f As Boolean
usor% = ActiveSheet.UsedRange.Rows.Count
uoszlop% = ActiveSheet.UsedRange.Columns.Count
Set WS = Sheets("Munka2")
sorW% = 2
Sheets("Munka1").Select
Application.ScreenUpdating = False
For sor% = 2 To usor%
cikksz = Cells(sor%, 1)
For oszlop% = 2 To uoszlop%
If Application.WorksheetFunction.CountA(Rows(sor%)) > 1 Then
f = False
If Cells(sor%, oszlop%) > 0 Then
WS.Cells(sorW%, 1) = cikksz
WS.Cells(sorW%, 2) = Cells(1, oszlop%)
WS.Cells(sorW%, 3) = Cells(sor%, oszlop%)
f = True
End If
End If
If f Then sorW% = sorW% + 1
Next
Next
Sheets("Munka2").Select
Application.ScreenUpdating = False
End SubSzerk.: a sorok és oszlopok számától függően elmókuskálhat a makró egy darabig.
Új hozzászólás Aktív témák
- ASUS ROG Zephyrus G14 - 14" WUXGA 144Hz - Ryzen 9 6900HS - 16GB - 1TB - Win11 - RX 6800S 8GB - HUN
- Hordozható napelem 10 Watt / 12 hó jótállás
- Creative Sound BlasterX G6 7.1 USB külső hangkártya
- GYÖNYÖRŰ iPhone 13 Pro 256GB Sierra Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS3360, 100% Akkumulátor
- Gamer PC i5 14. gen. // RTX 3080 // BOLTBÓL 27%-os SZÁMLÁVAL, GARANCIÁVAL //
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest


Fferi50
