Hirdetés
- Luck Dragon: Asszociációs játék. :)
- sh4d0w: Netflix? Ugyan, VW előfizetés!
- Olcsó/régi telefonok fotói egymás mellett
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- sziku69: Fűzzük össze a szavakat :)
- antikomcsi: Ázsia Expressz 5
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- eBay-es kütyük kis pénzért
- Elektromos rásegítésű kerékpárok
- sziku69: Szólánc.
-
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
Fferi50
#45398
üzenetére
Hát még, ha tagolva lenne a makró! Akkor látszana, ki kivel van.
Function Poisson2(Feltétel2 As Range) As Long
Call kep_ki
Application.Volatile 'Prohardver Delila_1 nyomán
k = 0
Kezd = Cells(8, 7) 'Feltétel kezdete oszlop
Kezd5 = Kezd + 5 'Javasolt számok terület előtti oszlop száma
Kezd22 = Kezd + 22 'Feltételek a javaslat válogatásához
a = Cells(12, Kezd) 'A munkatábla kezdő előtti oszlop száma
Előford = Kezd + a 'K(i) táblázat kezdő előtti oszlop száma
Valószín = Előford + 90 'P(x=1) táblázat kezdő előtti oszlop száma
Várak = Valószín + 90 'n(i) táblázat kezdő előtti oszlop száma
Us = Cells(4, 7) + Cells(2, 7) 'Táblázat utolsó sora
Cikl = Cells(5, Előford + 1) 'A számolás kezdete sor
Cells(6, Előford + 1) = Cikl 'Ez lesz a Ciklusváltozó kezdete
Range(Cells(Cikl + 1, Kezd + 1), Cells(Us, Kezd + 15)).ClearContents 'számítása sorok törlése
Range(Cells(Cikl, Előford + 1), Cells(Us, Valószín)).ClearContents 'K(i) táblázat törlése
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'Feltételek
Range("AF11:AJ11").Value = Range("AF4:AJ4").Value 'Manuális számítás
'Calculate 'A munkalapfüggvények számolása
For Cikl = Cells(6, Előford + 1) To Us 'Az utolsó + 1-ig
'1. : 'Az n(i-1) és az előző ciklusban kitörölt képletek újrafelépítése a Tartalék raktárcellából BF14
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula 'Képlet
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'[P(x=1) 13-dik sor]
For i = 1 To 5
For j = 1 To 90
Calculate 'A munkalapfüggvények kiszámolják a 14-dik
If Cells(13, Előford + j) <= Cells(11, Kezd22 + i) And Cells(14, Előford + j) Then
For k = 1 To 5
If Cells(14, Előford + j) = Cells(Cikl, Kezd5 + k) Then GoTo Köv
Next k
Cells(Cikl, Kezd5 + Cells(17, Kezd5 + i)) = Cells(14, Előford + j)
Cells(Cikl, Kezd + 10 + Cells(17, Kezd5 + i)) = Cells(13, Előford + j)
Cells(14, Előford + j) = ""
j = 90
End If
Köv:
Next j
Next i
'2.
Cells(6, Előford + 1) = Cikl
'Calculate 'A munkalapfüggvények számolása
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Kezd + j) = Cells(12, Előford + Cells(Cikl, 3 + j))
Next j
End If
'Calculate 'A munkalapfüggvények számolása
Range(Cells(Cikl, Előford + 1), Cells(Cikl, Valószín)).Value _
= Range(Cells(Cikl - 1, Előford + 1), Cells(Cikl - 1, Valószín)).Value
For j = 1 To 90
Cells(8, Előford + j) = Cells(8, Előford + j) + 1 'n(i) cellasor munkatáblában(i) cellasor
Next j
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Előford + Cells(Cikl, 3 + j)) _
= Cells(Cikl, Előford + Cells(Cikl, 3 + j)) + 1
Cells(8, Előford + Cells(Cikl, 3 + j)) = 0 'n(i) cellasor
Next j
End If
'Calculate
Range(Cells(Cikl, Valószín + 1), Cells(Cikl, Várak)).Value _
= Range(Cells(12, Előford + 1), Cells(12, Valószín)).Value
Range(Cells(Cikl, Várak + 1), Cells(Cikl, Várak + 90)).Value _
= Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value
Next Cikl
Call CountCcolor 'Prohardver nyomám Színes cellák számolása**** Modul3 lapon
Poisson2 = WorksheetFunction.Sum(Range("O14:S14")) 'Solver Célcella
Call kep_be
End Function -
Fferi50
Topikgazda
Szia!
Mutatom a </> gombot:
És az eredménye:Function Poisson2(Feltétel2 As Range) As Long
Call kep_ki
Application.Volatile ’Prohardver Delila_1 nyomán
k = 0
Kezd = Cells(8, 7) 'Feltétel kezdete oszlop
Kezd5 = Kezd + 5 'Javasolt számok terület előtti oszlop száma
Kezd22 = Kezd + 22 'Feltételek a javaslat válogatásához
a = Cells(12, Kezd) 'A munkatábla kezdő előtti oszlop száma
Előford = Kezd + a 'K(i) táblázat kezdő előtti oszlop száma
Valószín = Előford + 90 'P(x=1) táblázat kezdő előtti oszlop száma
Várak = Valószín + 90 'n(i) táblázat kezdő előtti oszlop száma
Us = Cells(4, 7) + Cells(2, 7) 'Táblázat utolsó sora
Cikl = Cells(5, Előford + 1) 'A számolás kezdete sor
Cells(6, Előford + 1) = Cikl 'Ez lesz a Ciklusváltozó kezdete
Range(Cells(Cikl + 1, Kezd + 1), Cells(Us, Kezd + 15)).ClearContents 'számítása sorok törlése
Range(Cells(Cikl, Előford + 1), Cells(Us, Valószín)).ClearContents 'K(i) táblázat törlése
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'Feltételek
Range("AF11:AJ11").Value = Range("AF4:AJ4").Value 'Manuális számítás
'Calculate 'A munkalapfüggvények számolása
For Cikl = Cells(6, Előford + 1) To Us 'Az utolsó + 1-ig
'1. : 'Az n(i-1) és az előző ciklusban kitörölt képletek újrafelépítése a Tartalék raktárcellából BF14
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula 'Képlet
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'[P(x=1) 13-dik sor]
For i = 1 To 5
For j = 1 To 90
Calculate 'A munkalapfüggvények kiszámolják a 14-dik
If Cells(13, Előford + j) <= Cells(11, Kezd22 + i) _
And Cells(14, Előford + j) Then
For k = 1 To 5
If Cells(14, Előford + j) = Cells(Cikl, Kezd5 + k) Then GoTo Köv
Next k
Cells(Cikl, Kezd5 + Cells(17, Kezd5 + i)) = Cells(14, Előford + j)
Cells(Cikl, Kezd + 10 + Cells(17, Kezd5 + i)) = Cells(13, Előford + j)
Cells(14, Előford + j) = ""
j = 90
End If
Köv: Next j
Next i
'2.
Cells(6, Előford + 1) = Cikl
'Calculate 'A munkalapfüggvények számolása
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Kezd + j) = Cells(12, Előford + Cells(Cikl, 3 + j))
Next j
Else
End If
'Calculate 'A munkalapfüggvények számolása
Range(Cells(Cikl, Előford + 1), Cells(Cikl, Valószín)).Value _
= Range(Cells(Cikl - 1, Előford + 1), Cells(Cikl - 1, Valószín)).Value
For j = 1 To 90
Cells(8, Előford + j) = Cells(8, Előford + j) + 1 'n(i) cellasor munkatáblában(i) cellasor
Next j
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Előford + Cells(Cikl, 3 + j)) _
= Cells(Cikl, Előford + Cells(Cikl, 3 + j)) + 1
Cells(8, Előford + Cells(Cikl, 3 + j)) = 0 'n(i) cellasor
Next j
End If
'Calculate
Range(Cells(Cikl, Valószín + 1), Cells(Cikl, Várak)).Value _
= Range(Cells(12, Előford + 1), Cells(12, Valószín)).Value
Range(Cells(Cikl, Várak + 1), Cells(Cikl, Várak + 90)).Value _
= Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value
Next Cikl
Call CountCcolor 'Prohardver nyomám Színes cellák számolása**** Modul3 lapon
Poisson2 = WorksheetFunction.Sum(Range("O14:S14")) 'Solver Célcella
Call kep_be
End Function
Amint látod, sokkal olvashatóbb.
Érdekes lenne még az a munkalap, amin futtatod ezt a makrót. Legalább egy kép a használt területről.
Üdv. -
KBaj
kezdő
válasz
Fferi50
#45396
üzenetére
Kedves Fferi50 !
Ime a program, elég hosszú. Persze ez is függvény azért, mert ha fog működni SOLVER célcellájaként akarom alkalmazni.
Function Poisson2(Feltétel2 As Range) As Long
Call kep_ki
Application.Volatile ’Prohardver Delila_1 nyomán
k = 0
Kezd = Cells(8, 7) 'Feltétel kezdete oszlop
Kezd5 = Kezd + 5 'Javasolt számok terület előtti oszlop száma
Kezd22 = Kezd + 22 'Feltételek a javaslat válogatásához
a = Cells(12, Kezd) 'A munkatábla kezdő előtti oszlop száma
Előford = Kezd + a 'K(i) táblázat kezdő előtti oszlop száma
Valószín = Előford + 90 'P(x=1) táblázat kezdő előtti oszlop száma
Várak = Valószín + 90 'n(i) táblázat kezdő előtti oszlop száma
Us = Cells(4, 7) + Cells(2, 7) 'Táblázat utolsó sora
Cikl = Cells(5, Előford + 1) 'A számolás kezdete sor
Cells(6, Előford + 1) = Cikl 'Ez lesz a Ciklusváltozó kezdete
Range(Cells(Cikl + 1, Kezd + 1), Cells(Us, Kezd + 15)).ClearContents 'számítása sorok törlése
Range(Cells(Cikl, Előford + 1), Cells(Us, Valószín)).ClearContents 'K(i) táblázat törlése
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'Feltételek
Range("AF11:AJ11").Value = Range("AF4:AJ4").Value 'Manuális számítás
'Calculate 'A munkalapfüggvények számolása
For Cikl = Cells(6, Előford + 1) To Us 'Az utolsó + 1-ig
'1. : 'Az n(i-1) és az előző ciklusban kitörölt képletek újrafelépítése a Tartalék raktárcellából BF14
Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value = _
Range(Cells(Cikl - 1, Várak + 1), Cells(Cikl - 1, Várak + 90)).Value 'Az n(i-1) sor feltöltése
Cells(14, Előford + 1).Formula = Cells(14, Kezd + 49).Formula 'Képlet
Cells(14, Előford + 1).Select 'Kijelölés kitöltéshez
Selection.AutoFill Destination:=Range(Cells(14, Előford + 1), Cells(14, Valószín)), Type:=xlFillDefault
'[P(x=1) 13-dik sor]
For i = 1 To 5
For j = 1 To 90
Calculate 'A munkalapfüggvények kiszámolják a 14-dik
If Cells(13, Előford + j) <= Cells(11, Kezd22 + i) _
And Cells(14, Előford + j) Then
For k = 1 To 5
If Cells(14, Előford + j) = Cells(Cikl, Kezd5 + k) Then GoTo Köv
Next k
Cells(Cikl, Kezd5 + Cells(17, Kezd5 + i)) = Cells(14, Előford + j)
Cells(Cikl, Kezd + 10 + Cells(17, Kezd5 + i)) = Cells(13, Előford + j)
Cells(14, Előford + j) = ""
j = 90
End If
Köv: Next j
Next i
'2.
Cells(6, Előford + 1) = Cikl
'Calculate 'A munkalapfüggvények számolása
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Kezd + j) = Cells(12, Előford + Cells(Cikl, 3 + j))
Next j
Else
End If
'Calculate 'A munkalapfüggvények számolása
Range(Cells(Cikl, Előford + 1), Cells(Cikl, Valószín)).Value _
= Range(Cells(Cikl - 1, Előford + 1), Cells(Cikl - 1, Valószín)).Value
For j = 1 To 90
Cells(8, Előford + j) = Cells(8, Előford + j) + 1 'n(i) cellasor munkatáblában(i) cellasor
Next j
If Cells(Cikl, 4) Then
For j = 1 To 5
Cells(Cikl, Előford + Cells(Cikl, 3 + j)) _
= Cells(Cikl, Előford + Cells(Cikl, 3 + j)) + 1
Cells(8, Előford + Cells(Cikl, 3 + j)) = 0 'n(i) cellasor
Next j
End If
'Calculate
Range(Cells(Cikl, Valószín + 1), Cells(Cikl, Várak)).Value _
= Range(Cells(12, Előford + 1), Cells(12, Valószín)).Value
Range(Cells(Cikl, Várak + 1), Cells(Cikl, Várak + 90)).Value _
= Range(Cells(8, Előford + 1), Cells(8, Valószín)).Value
Next Cikl
Call CountCcolor 'Prohardver nyomám Színes cellák számolása**** Modul3 lapon
Poisson2 = WorksheetFunction.Sum(Range("O14:S14")) 'Solver Célcella
Call kep_be
End Function
Elég hosszú a program, van még mit csiszolni, egyszerűsíteni rajta. Mint már említettem kezdő programozó vagyok, nem értem a (</>) gombot mit jelent.
Segítségedet előre is köszönöm.
Üdvözlettel:
KBaj -
KBaj
kezdő
válasz
Fferi50
#45384
üzenetére
Kedves Fferi50 !
Nagy lelkesedésemben eljutottam egy korábban kiderített hibához, amit azóta sem tudtam megoldani, sem megmagyarázni. Konkrétan a 45372 számú bejegyzésemben tett tapasztalásomhoz. Miszerint egy darabig a VB végrehajtja az utasításokat és adott sortól egyszerűen otthagyja a programot, visszatér az munkalaphoz, mintha egy END SUB-ot kapott volna.
Nem tudom mit tegyek. Tudnál segíteni?
Üdvözlettel:
KBaj -
Sziasztok!
Az alábbi lenne a problémám:
C oszlop cikkszámok
D oszlop partnerek
E oszlop árak az egyes partnerekhez
Ergo pl a 10259-ös cikkszámú terméket 10 partner is megveszi (10x szerepel a táblázatban 10 különböző áron) és nekem ennek a 10-nek kellene az átlaga. Hogyan kellene csinálni?Aztán ha ez megvan akkor az átlagárat hozzá kell kötni a cikkszámhoz is de azt hiszem ez már egy Vclookup-al menni fog.
Köszönöm
-
KBaj
kezdő
válasz
Fferi50
#45384
üzenetére
Kedves Fferi50 !
Mint ahogy írtam is a legutóbbi bejegyzésemben, dolgozom az ügyön és most félállásban vagyok, de igen jók a kilátások, hála Neked. A saját számíze szerint átírtam a kódot, úgy néz ki szépen működik és gyors!!! Íme a példa:
'***** Prohardver nyomám Színes cellák számolása
Sub CountCcolor() 'Cellaszín szerinti darabszám
Dim cel As Range, cminta As Range, cter As Range, countcl As Long
Dim xcolor As Long
Dim j As Integer
Range("O14:S14").ClearContents 'Színtalálatok törlése
'If Selection.Areas.Count <> 2 Then MsgBox "Nem megfelelő a terület kijelölése", vbCritical: Exit Sub
' If Selection.Areas(1).Cells.Count = 1 Then ' Kijelölt területek azonostása: Count=1 Mintaszín
' Set cminta = Selection.Areas(1): Set cter = Selection.Areas(2)
' Else
' Set cminta = Selection.Areas(2): Set cter = Selection.Areas(1)
' End If
Set cter = Range(Cells(3183, 15), Cells(3283, 19)) 'Vizsgáladó terület
'A Mintaszínek sorra vétele
For j = 1 To 3
Set cminta = Range(Cells(20, 14 + j), Cells(20, 14 + j)) 'Mintaszín
countcl = 0 'Színes cella számláló
xcolor = cminta.Interior.ColorIndex 'A mintaszín Index száma
For Each cel In cter.Cells 'Végig vizsgálandó területen
If cel.DisplayFormat.Interior.ColorIndex = xcolor Then 'Ha egyforma a vizsgált cella és minta színindexe
countcl = countcl + 1 'Számláló növelése
End If
Next cel
Cells(14, 14 + j) = countcl 'A színből talált darabszám
'MsgBox countcl
Next j
End Sub
Köszönöm szépen az alapötletet.
Üdvözlettel:
KBaj -
felsatan
tag
Sziasztok!
Adott 12 db külön álló excel fájl, amiben diákok vezetik a ledolgozott óráikat. Minden diáknak egy fül van a saját táblázatában. Hogyan tudnám a 12 fájl adatiat egy darab fájl 12 fülébe rendezni.
Magyarul azt szeretném, hogy amit változtat Pisti a saját fájljában, az frissüljön az én fájlomban is Pisti lapján.
Cellánként le tudom hivatkozni, de az irtó sokáig tart, úgyhogy bízom benne, van valami egyszerűbb megoldás is, ami nem igényel vba-t, mert ahhoz nem értek.
Hála és köszönet előre is! -
Delila_1
veterán
A CV>40 csak egy példa a feltételre, amivel színezed a tartomány elemeit. Nyilván a saját feltételedet kell beírni helyette.
Az Application.Volatile sor eredménye, hogy ha a területen belül megváltoztatod egy cella értékét úgy, hogy feleljen (vagy ne feleljen) meg a feltételnek, akkor az eredmény is automatikusan módosuljon az új értékre. -
Fferi50
Topikgazda
Szia!
Ez a makró azt tudja, hogy az M1,N1 cellákba beírt címek alapján megszámolja a színek számát és kiírja az O1 cellába.Sub CountCcolor1()
Dim cel As Range, cminta As Range, cter As Range, countcl As Long
Dim xcolor As Long
Set cter = Range(Range("M1").Value)
If cter.Cells.Count = 1 Then
Set cminta = cter: Set cter = Range(Range("N1").Value)
Else
Set cminta = Range(Range("N1").Value)
End If
countcl = 0
xcolor = cminta.DisplayFormat.Interior.ColorIndex
For Each cel In cter.Cells
If cel.DisplayFormat.Interior.ColorIndex = xcolor Then
countcl = countcl + 1
End If
Next cel
Range("O1").Value = countcl
End Sub
Az M1-be kell a vizsgálandó terület címe (Pl. A1 : D5), az N1-be kell a mintacella címe (pl.K4), vagy fordítva, fontos, hogy a mintacella egy cella legyen.7
Természetesen mindhárom cella címét (M1, N1, O1) átírhatod a neked megfelelőre. Fontos még, hogy ezek a cellák azon a munkalapon legyenek, ahol számoltatni szeretnél és onnan indítsd a makrót - amit természetesen akár egy gombhoz is hozzárendelhetsz.
Üdv.
Üdv. -
#45383
Fferi50
Topikgazda
szricsi_0917
#45380
Fferi50
Topikgazda
válasz
szricsi_0917
#45380
üzenetére
Szia!
Kicsit jobban ránéztem és az alábbiakat találtam:
1. Jó a Column, nem kell többesszám.
2. Az Index 2 dimenziós legyen és 0,0 val indul, ez az első oszlop első értéke
3. Első az oszlop index, második a sor index.
Tehát .Column(0,0) az első elem, .Column(0,1) az első oszlop második eleme.
Üdv. -
#45381
Fferi50
Topikgazda
szricsi_0917
#45380
Fferi50
Topikgazda
válasz
szricsi_0917
#45380
üzenetére
Biztos, hogy jó a Control neve? Mert az is "indexnek" számít. Bár arra más hibaüzenet jönne.
-
#45379
Fferi50
Topikgazda
szricsi_0917
#45378
Fferi50
Topikgazda
válasz
szricsi_0917
#45378
üzenetére
Szia!
Az index 0-val kezdődik szerintem, az egy oszloposnál Columns(0), úgy gondolom.
Üdv. -
Fferi50
Topikgazda
Szia!
Ha nem munkalap függvényként szeretnéd használni, akkor meg lehet oldani a megszámolást anélkül, hogy az eredeti feltételeket figyelni kellene.
Ahogy korábban írtam, ki kell jelölni a területet és a minta színt, ezután kell elindítani egy makrót.Sub CountCcolor1()
Dim cel As Range, cminta As Range, cter As Range,countcl As Long
Dim xcolor As Long
If Selection.Areas.Count <> 2 Then MsgBox "Nem megfelelő a terület kijelölése", vbCritical: Exit Sub
If Selection.Areas(1).Cells.Count = 1 Then
Set cminta = Selection.Areas(1): Set cter = Selection.Areas(2)
Else
Set cminta = Selection.Areas(2): Set cter = Selection.Areas(1)
End If
countcl = 0
xcolor = cminta.Interior.ColorIndex
For Each cel In cter.Cells
If cel.DisplayFormat.Interior.ColorIndex = xcolor Then
countcl = countcl + 1
End If
Next cel
MsgBox countcl
End Sub
Hogyan használható? Ki kell jelölnöd azt az összefüggő területet, ahol szeretnéd a színt összeszámolni. Ezután a CTRL nyomva tartásával ki kell hozzá jelölni a minta színt tartalmazó cellát - ami ne legyen a megszámolandó területen.
Ezután a Fejlesztőeszközök - Makrók menüpontban kiválasztod a CountColor1 -et és elindítod. Egy üzenetben kiírja a mintacella színének megfelelő cellák darabszámát.
Természetesen azt is meg lehet adni, hogy melyik cellába írja ki. Akkor az Msgbox sor helyett a Range("X3").Value=countcl sort kell beírnod - X3 helyett azt a címet, ahová szeretnéd az eredményt megkapni.
Megoldható továbbá az is, hogy egy vagy két cellába (ami mindig fix) beírjuk a vizsgálandó terület és a minta szín címét a makró futtatása előtt -- persze ahhoz módosítani kell a fenti makrót, de ez nem nagy probléma.
Amit Delila írt, az is megoldás, egy olyan makrót is lehet írni, ami megnézi, hogy a feltételes formázás feltételeinek melyik szín felel meg és azt a feltételt vizsgálja cellánként.
Erre még visszatérnék, csak azért írtam viszonylag gyorsan, hogy ne menjen el a kedved az egyébként hasznos feltételes formázás használatától.
Üdv. -
#45376
Fferi50
Topikgazda
szricsi_0917
#45374
Fferi50
Topikgazda
válasz
szricsi_0917
#45374
üzenetére
Szia!
.Columns(1)
Üdv. -
KBaj
kezdő
válasz
Fferi50
#45373
üzenetére
Kedves Fferi50 !
Szomorú vagyok. Nem gondoltam volna, hogy a feltételes formázás ilyen galibát tud okozni. Úgy látszik más utat kell választanom.
Hát így jártam.
Na, nem baj tovább keresem az utat. De sokat tanultan.
Köszönöm szépen az eddigi segítséget, tájékoztatást és útmutatást.
Üdvözlettel:
KBaj -
#45374
szricsi_0917
tag
szricsi_0917
tag
Sziasztok
Egy kis segítséget szeretnék kérni:Me.Controls("ida" & bb & "_osszerend_auto_box").Column(1)
Problémája van a combobox oszlopszámának megadásával. A Me.controls objektumba hogyan lehet megadni az oszlop számát?
Előre is köszi a segítséget! -
KBaj
kezdő
válasz
Delila_1
#45369
üzenetére
Kedves Fferi50 és Delila_1 !
Köszönöm Delila_1, hogy Te is bekapcsolódtál a beszélgetésbe. Érdekes a javaslatod, de kezdő vagyok és nem nagyon értem minden sorát. Különösen az Application.Volatile sort, miért kell bele? A CV > 40 sornál mi a 40-es szám?
Időközben kísérletezgetek: VBA futtatását Hibakeresés módszerrel: a kód sorokban megállító pöttyöket helyezek el és így vizsgálom, hogy hogyan változnak a változók.
Egy másik szintén félig kész függvényen érdekes dolgot tapasztaltam. A függvény eleje a későbbi programban felhasználandó változók kezdő értékét tartalmazza, konstans, munkalap cella konstans, munkalap cella, mely beépített függvény szerinti kiszámított értéket adja a cellának. Azonban az első két módszer szerint rendben megy, de a beépített függvény szerinti értékadást egyszerűen kihagyja (a példa szerinti a = Cells(12, Kezd) sor). A megállás helyét sárga színnel jelzett állapotban a kurzort a változó fölé víve Empty hibát mutat, pedig utána is elvégzi a munkát.
Továbbá egy ponttól nem megy tovább, kilép. Pedig nem szokatlan programsort kellene végrehajtania. Úgy tudom (és remélem jól tudom), hogy a VBA a programot ahogy látható a szerkesztő ablakban föntről lefelé, sorban egymás után kell végrehajtani. Ime a kódrészlet:
Function Poisson2(Feltétel2 As Range) As Long
Call kep_ki
k = 0
Kezd = Cells(8, 7)
Kezd5 = Kezd + 5
a = Cells(12, Kezd)
Előford = Kezd + a
Valószín = Előford + 90
Várak = Valószín + 90
Us = Cells(4, 7) + Cells(2, 7)
Cikl = Cells(5, Előford + 1)
Cells(6, Előford + 1) = Cikl
Range(Cells(Cikl + 1, Kezd + 1), Cells(Us, Kezd + 15)).ClearContents
Az utolsó előtti sort még végrehajtja (ez a megállás helye szerinti sor), az utolsót viszont nem, visszatér a munkatáblához Erték hibával.
Kedves Fferi50 bejegyzésedben a Cella.DisplayFormat.Interior.Color(index) utasítsró írsz. A fenti programrészletben nincs ilyen, mégsem emészti meg a VBA.
(Nekem is 2016 Excel van)
Üdvözlettel:
KBaj -
#45370
Hege1234
addikt
m.zmrzlina
#45360
Hege1234
addikt
válasz
m.zmrzlina
#45360
üzenetére
igen, az volt a jó ahogy írtad
köszi a segítséget és a példát -
Fferi50
Topikgazda
válasz
Delila_1
#45367
üzenetére
Szia!
Azért az tiszta őrület, hogy amikor végre megalkották a DisplayFormat -ot, hogy ne kelljen a feltételes formázással küzdeni pl. a színek vizsgálatánál, akkor felhasználói függvénnyel nem működik. Normál eljárással - paraméterezve is - működik - , de abban az esetben, ha ezt függvényből hívnánk meg a munkalapon, azonnal hibát okoz.
Mivel a Cella.Interior.Color(index) működik felhasználói függvény formában is, a Cella.DisplayFormat.Interior.Color(index) viszont nem, feltételezhetően valami apró bug lehet a megalkotásában. Elhatároztam, hogy jelezni fogom a MS oldalon. Kíváncsi vagyok, mit válaszolnak majd.
(Nálam 2016-os Excel fut, de a magasabb verzióban is fennáll a jelenség....)
Üdv. -
Delila_1
veterán
Szerintem a feltételt kellene megadnod a ciklusban, ami színezi a cellákat.
Function FeltetelesDarabszam(Tartomany As Range)
Dim CV As Range, db As Integer
Application.Volatile
db = 0
For Each CV In Tartomany
If CV > 40 Then db = db + 1
Next CV
FeltetelesDarabszam = db
End Function -
Fferi50
Topikgazda
Szia!
Nemrég volt egy hasonló "házi" problémám, most "emlékeztettél" rá.
Sajnos úgy néz ki, hogy függvénnyel nem lehet megoldani a problémát, mert a DisplayFormat tulajdonságot ebben a formában nem tudja "megemészteni" a VBA.
Normál eljárással (SUB) megy, de akkor meg kell oldani a paraméter átadást.
Már későre jár, ezért inkább holnap folytatnám.
Üdv. -
KBaj
kezdő
válasz
Fferi50
#45364
üzenetére
Kedves Fferi50!
Először is köszönöm a gratulációt. 4 éves, imádom.
Köszönöm szépen a segítségeket és magyarázatokat is. A Set sort kiszedtem. Az If sorban betettem a DisplayFormat. szót, azonban így sem működik rendesen. Leírom mit tapasztaltam:
Function CountCcolor1(CellaSzín1 As Range, range_data As Range) As Long
Dim cel As Range
Dim xcolor As Long
xcolor = CellaSzín1.Interior.ColorIndex
For Each cel In range_data.Cells
If cel.DisplayFormat.Interior.ColorIndex = xcolor Then
CountCcolor1 = CountCcolor1 + 1
End If
Next cel
End Function
- Az utolsó sorba tettem margón kívülre egy megállító pöttyöt, hogy ha az Excel rámegy akkor megálljon.
- A DisplayFormat. beírás nélkül lefut. Azt, hogy lefut látom, mert megáll a pöttynél és besárgul. A kis háromszögre kattintva tovább megy (ahogy kell) és az eredménycellában nulla szám jelenik meg.
- DisplayFormat. beírással nem tudom mi történik, de nem jár a pöttynél, mert nem áll meg. Azonban az eredménycella #ÉRTÉK hibaüzenetre vált.
- Az eredménycella újraszámolását (függvényem meghívását) F2 billentyű előhívással és javítás nélkül enterrel újrabeírással kényszerítettem ki.
A CountCcolor1 és CellaSzín1 végén az 1-es (majd 2, 3, ...) jelzi majd, hogy melyik színt keresi.
Próbáltam beírni a xcolor = CellaSzín2.DisplayFormat.Interior.ColorIndex sorba is, de ugyan úgy nem állt meg a pöttynél és #ÉRTÉK hibaüzenet adott.
Nem tudom mit csináljak, pedig szerintem a feladat nem olyan nehéz: meg kéne számolni, hogy egy területen hány piros, kék, …. kitöltőszínű cella van.
Üdvözlettel:
KBaj -
Fferi50
Topikgazda
Szia!
"azt hittem mindegy a sorrend, hisz a VBA nevek szerint tudja azonosítani öket"
Ez igaz, de akkor másként kell meghívni a függvényt és csak VBA-ban működik, pl.CountCcolor CellaSzín1:=Range("A1"), range_data:=Range("X2:Z13")
Munkalapon nem lehet így meghívni. Ha nevet szeretnél használni, akkor a Képletek - Névkezelő menüpontban kell hozzárendelni neveket a kívánt tartományokhoz.
Ekkor viszont csak azokkal a tartományokkal fog működni - ha más tartományt szeretnél használni, akkor a nevet kell módosítani.
"ha pl. átlagot akarok számolni VBA-ban For-Next ciklussal nagyon-nagyon lassabb mint a beépített ÁTLAG() függvény"
Ez természetes, hiszen a beépített függvények gépi kódban futnak. Ezért is indokolt és célszerű az Excel beépített eszközeit használni, amikor csak lehetséges - VBA-ból is meghívva azokat.
"a Set sor azért került bele, mert később, sok-sok futás után VBA szinten módosítani (növelni) akarom a terület nagyságát. Ez gondolom felülírja az induláskor Excel táblán manuálisan beállított értékeket"
Igen, felülírja a meghíváskor megadott értéket - de mindig fixen arra, amit beírtál a makróba. A terület nagyság változtatását a makróhoz való hozzányúlás nélkül, a paraméter változtatásával tudod megoldani. (A terület paraméterhez pl.X2 : Y7 helyett X2 : AA72 kerül a meghíváskor.)
Azért vannak a paraméterek, hogy ne a (makró)függvényt kelljen módosítani, ha mást is szeretnél vele számoltatni.
Üdv.
Ps. Unokához gratula. -
KBaj
kezdő
válasz
Fferi50
#45362
üzenetére
Kedves Fferi50!
Nagyon köszönöm, hogy ilyen hamar reagáltál a problémámra.
Válaszod felsorolása szerint fogok én is viszontválaszolni:
A függvény leírás és hívás paraméterek sorrendjét szinkronizáltam. (Tanultam: azt hittem mindegy a sorrend, hisz a VBA nevek szerint tudja azonosítani öket.) A függvénybe a Set sor azért került bele, mert később, sok-sok futás után VBA szinten módosítani (növelni) akarom a terület nagyságát. Ez gondolom felülírja az induláskor Excel táblán manuálisan beállított értékeket. Feltételes formázás: nem tudtam, hogy cella interior.color színe nem változik. Kicseréltem a feltétel sort. (Tanultam: feltételes formázás csak a mutatott képet (Display) módosítja?) Táblafüggvény: Eddigi értelmezésem szerint az a függvény ami az Excel megnyitásakor képernyőn jelentkező táblázat bármely cellájában beírható vagy található =f(x) formátumú, kódja „gyárilag” Microsoft programban vagy egyénileg VBA Modullapon van megírva. Tapasztaltam már, ha pl. átlagot akarok számolni VBA-ban For-Next ciklussal nagyon-nagyon lassabb mint a beépített ÁTLAG() függvény.
Még nem teszteltem a módosításokat, mert megjött az unokám, aki nagyon vártam.
Köszönöm a segítséget.
Üdvözlettel:
KBaj -
Fferi50
Topikgazda
Szia!
Van némi gond azzal, amit leírtál. Először:
a függvényFunction CountCcolor(range_data As Range, CellaSzín1 As Range)
Azaz az első paraméter a vizsgálandó terület, a második a mintaszín cellája.
A hívásnál pedig ezt írod:CountCcolor(CellaSzín1;range_data)
azaz fordítva adod meg a paramétereket!
Másodszor:
Magába a függvénybe bekerült ez a sor:Set range_data = Application.Range("Munka1!O3183:S3284")
Ez tehát minden alkalommal felülír(ná) az általad megadott területet. A vizsgálandó terület ott van az első paraméterben, ez a sor káros. (Azért írtam feltételes módban, mert a hívásnál rosszul adod meg a paramétereket.)
Harmadszor:
Feltételes formázás esetén a cella interior.color színe marad az eredeti és nem a formázott. Ebben az esetben a Range.DisplayFormat tulajdonságát kell használni.If cel.DisplayFormat.Interior.Colorindex=xcolor
Negyedszer:
Mit értesz táblafüggvény alatt? A felhasználói függvény szintén VBA-ban íródik és ha jól látom akkor For Each -..... -Next ciklus van ebben is (ez is kell bele). Ez mitől is gyorsabb mint a VBA ciklus...
Üdv. -
KBaj
kezdő
Kedves Mindenki!
Régen jelentkeztem, de eléggé lekötnek a munkáim.
A jelenlegi munkámban akadt egy feladat amiben nem tudok dűlőre jutni, ezért kérném és megköszönném a segítségeteket.
Feladat: Adott egy táblázat, melyben van egy range_data névvel elnevezett Range és egycellából álló CellaSzín1 nevű Range tartomány. A cél az, hogy egy tetszőleges eredmény cellában (minél gyorsabban) megszámoljuk a CellaSzín1 nevű cella kitöltő színével megegyező range_data celláit, melyek a keresést megelőzően Excel táblában beállított feltételes formázással lett megszínezve több féle színnel.
Az interneten való kutakodás után a következőkre jutottam: Talán a legjobb lenne táblafüggvényt írni, mert azt sokkal hamarabb elvégzi az Excel, mint a lomha VBA For-Next ciklust. Így az alábbival próbálkoztam:
Function CountCcolor(range_data As Range, CellaSzín1 As Range) As Long
Dim cel As Range
Dim xcolor As Long
Set range_data = Application.Range("Munka1!O3183:S3284")
xcolor = CellaSzín1.Interior.ColorIndex
For Each cel In range_data.Cells
If cel.Interior.ColorIndex = xcolor Then
CountCcolor = CountCcolor + 1
End If
Next cel
End Function
A tetszőleges cellába írtam a meghívó függvényt: =CountCcolor(CellaSzín1;range_data) azzal a szándékkal, hogy a tábla újraszámolás utasításra (amely lehet automatikus Excel vagy VBA külön utasítás) beírja a cellába a range_data tartományban talált CellaSzín1 cella alapszínével megegyező cellák darabszámát. De sajnos nem így van. A funkció függvény lefut ugyan, de nem működik stabilan, ha nem #ÉRTÉK hibát jelez akkor a kijelzett szám annyi mint a vizsgált terület „szín nincs” összes celláinak száma (CellaSzín1.Interior.ColorIndex=-4142; negatív, tehát nincs szín). Pedig lenne mit összeszámolni.
Nem tudom hogyan tovább?
Tisztelettel megkérek Mindenkit, aki tud segítsen.
A segítséget előre is köszönöm.
Kbaj -
#45360
m.zmrzlina
senior tag
Hege1234
#45359
m.zmrzlina
senior tag
válasz
Hege1234
#45359
üzenetére
Állnak a gyerekek a tornasorban. (nem mostanság, mondjuk 40 évvel ezelőtt, manapság nem frusztráljuk a tökmagot, hogy ő mindig az utolsó
) Nagyság szerint a legnagyobb áll elöl a legkisebb hátul. A második legnagyobb gyerek a sorban a második. Nálad ez az 55 és a 15 ez rendben van. A legkisebb áll hátul, a második legkisebb előtte eggyel. Nálad a legkisebb a 4 ez oké, a második legkisebb szerintem a 7.Majd holnap írd meg, hogy a tanárod hogyan értelmezte a feladatot? Nagy összegbe mernék fogadni, hogy hasonlóképpen ahogyan én.
-
#45359
Hege1234
addikt
m.zmrzlina
#45358
Hege1234
addikt
válasz
m.zmrzlina
#45358
üzenetére
nagyság szerint az utolsó előtti számot kéri
ez nálam a 15
=KICSI(C2:c11;9)
amit te mutatsz ott kiválasztottam a 9 -et
mivel úgy adja meg az utolsó előtti számotvagy azért nem értem mert
nekem a 2. legnagyobb és az Utolsó előtti
az ugyan az vagyis mindkét sorba ez kerül?
=NAGY(C2:c11;2) -
#45357
Hege1234
addikt
m.zmrzlina
#45356
Hege1234
addikt
válasz
m.zmrzlina
#45356
üzenetére
ohh.. tényleg félreértettem
igen a =NAGY(C2:C11;2) fv-t használtam hozzá
ha most már jól értem akkor ez a megoldás hozzá
=KICSI(C2:C11;9)
köszi a segítséget! -
#45356
m.zmrzlina
senior tag
Hege1234
#45355
m.zmrzlina
senior tag
válasz
Hege1234
#45355
üzenetére
Szerintem te félreértetted a feladatot. Az van benne, hogy nagyság szerint az utolsó előtti számot kéri. Nem pedig a C2-C11tartomány utolsó előtti értékét. Ha a második legnagyobb számot a =NAGY() fv-nyel csináltad (én azzal csináltam volna) annak van egy párja =KICSI() Így már szerintem magad is meg tudod oldani.
-
#45355
Hege1234
addikt
m.zmrzlina
#45354
Hege1234
addikt
válasz
m.zmrzlina
#45354
üzenetére
ennyit kaptunk ez a 7. feladat
képFKERES, INDEX?
nekem egyik se rémlik..
ezek szerint akkor van több megoldás is
melyik lenne a legegyszerűbb?
(kezdő szinten) -
baaka
tag
Sziasztok!
Office 365-ben(hun) nan egy nyilvántartásom, amelynek az egyik oszlopában hivatkozások vannak. Ezek a hivatkozások .pdf fájlokra mutatnak melyek egy adott mappában vannak(az összes .pdf egy mappában van). Átszeretném nevezni ezt a mappát, valahogy meglehetne oldani egyszerűen, hogy a hivatkozások lekövessék ezt az útvonal módosítás egyszerűen és ne keljen egyessével újra meghivatkozni minden .pdf-et? -
expresss
csendes újonc
Sziasztok,
Egy olyan kérdésem, lenne hogy ha van egy régi exel táblám aminél van cikkszám, megnevezés, ár, de ez a tábla frissül és az "ár" oszlop megváltozik, hogyan tudom a két táblát úgy összehasonlítani hogy a régi tábla "ár" oszlopába az új tábla "ár" oszlopának elemei legyenek.
Régi tábla elemeinek értékét cseréli új tábla azonos elemeinek értékére.
Köszi -
atyca
senior tag
válasz
Fferi50
#45346
üzenetére
Van, és egyazon munkafüzetben.
A név is stimmel,nehéz lenne elrontani.
És manuálisan linkelve formailag ugyanaz, és működik is.....
A listába mind parancsra megjelennek a találatok, védelem kikapcsolva a lapon.
A neten sem találtam megoldást, bár ebbe sekélyes angol tudásom biztos belejátszik.
Közben egy régebbi hónap beosztástervezetét véve alapul sablonként helyre állt (kop-kop-kop) a rend, de továbbra sem értem mi történt.
Megsérült a fájl?
Megbuggyant az Office? -
Fferi50
Topikgazda
válasz
Sprite75
#45344
üzenetére
Szia!
Azért nem működik az automatikus mentés, mert az sNev változó a régi munkafüzet nevét tartalmazza.
A Thisworkbook kódlapján az AfterSave eseménykezelőbe írd be, hogy változzon meg az sNev tartalma.Private Sub Workbook_AfterSave(ByVal Success As Boolean)Mentes.sNev = ThisWorkbook.NameEnd Sub
Így a mentés után már az új név lesz érvényes.
Elképzelhető, hogy az időzítőket is újra kell indítani, de ezt egy próba után már látni fogod, akkor ugyanide kell beírni az elindításukat.
Üdv. -
Sprite75
tag
válasz
Sprite75
#44927
üzenetére
Sziasztok.
Van ez a [link] rendelős táblázatom amiben [link] ilyen auotomatikus mentős makrók is vannak.
Ezt úgy használják, hogy reggel megnyitják (a file neve az hogy reggeli nyitó) aztán mentés másként-al mentik ugyhogy a file neve pl ma 11-17 lesz.
Van egy olyan probléma vele, hogy ilyenkor ha nem zárják be a táblázatot és nem nyitják ujra már a 11-17 nevűt akkor nem műköödnek a fentebb linkelt automatikus mentés makrók.
Viszont egyéb makró működik a táblázatban.Ha bezárják és ujra nyitják (ahogy javasoltam a kollégának) akkorfeldogja az excel hogy a makrók le vannak tiltva akarod-e engedélyezni... Természetesen ha itt rá nyomnak hogy igen akkor minen ok. Működik az automatikus mentés is innentől kezdve.
Hogyan lehetne ezt kijátszani, hogy a mentés másként után ne kelljen bezárni a táblázatot,
(mert sajnos ezt sokszor elfelejtik reggelente)
hogy elinduljun az aut mentések időzítője így is amik a ThisWorkbook -on Private Sub Workbook_Open() alatt vannak .? -
atyca
senior tag
Sziasztok!
Mostanában egy szolgálati beosztást tartalmazó excel munkafüzet furcsaságával szenvedek.
(amit főleg a Ti segítségetekkel készítettem )
Amikor egy oszlop celláiban a képleteket - melyek a 2020.december fülre mutatnak - ctrl+f segítségével tömegesen szeretném módosítani - 2021.január fülre hivatkozva -, akkor megnyílik egy új win ablak "Értékek frissítése 2021.január".
Entert nyomva HIV értéket ad a cella....
Manuálisan betallózva rendesen működik, de úgy idő, és energiarabló a dolog.
Remélem érthető voltam, köszönök előre is minden segítséget. -
tcsaba007
tag
válasz
m.zmrzlina
#45340
üzenetére
Köszi!!!!
-
tcsaba007
tag
Sziasztok!
Nem nagyon használok excelt, nézzétek el nekem, hogy egy olyan kérdéssel fordulok hozzátok, aminek a megoldása valószínűleg olyan egyszerű, mint a lejtő, de én nem tudom megugrani..
Megnyitottam egy új online sablont: Kapcsolatlista.
Ha rákattintok pl a Vevőazonosító cellára, akkor egy szövegboxban egy megjegyzést olvashatok. Ez látszik a mellékelt képen. Hogy tudom ezt a szöveget editálni?
-
Mutt
senior tag
Másik fórumon a kérdés az volt, hogy van-e olyan függvény amely megadja hogy egy listából mely számok hiányoznak.
pl. 1, 2, 4 esetén a 3-as hiányzik
Hogy hány szám hiányzik egy növekvő számsorból azt meg lehet kapni az alábbi képlettel
= (maximum érték - minimum érték) / lépésköz + 1 - számok darabszáma
A fenti esetben = (4-1) /1 + 1 - 3 = 1 db szám hiányzik.Ha csak 1 db hiányzik, akkor 2 HOL.VAN segít a megadni a hiányzó számot.
=HOL.VAN(HAMIS;SZÁM(HOL.VAN(SOR(INDIREKT("$A"&MIN(A:A)&":$A"&MAX(A:A)));A:A;0));0)+MIN(A:A)-1
Ha több hiányzik, akkor többet kell küzdenünk hogy egy cellában megjelenjenek a számok.
=SZÖVEGÖSSZEFŰZÉS(",";IGAZ;ÖSSZESÍT(15;6;SOR(INDIREKT("$A"&MIN(A:A)&":$A"&MAX(A:A)))/(1-SZÁM(HOL.VAN(SOR(INDIREKT("$A"&MIN(A:A)&":$A"&MAX(A:A)));A:A;0)));SOR(INDIREKT("$A1:$A"&MAX(A:A)-MIN(A:A)+1-DARAB(A:A)))))
Mindegyik esetben a SOR(INDIREKT("$A"&MIN(A:A)&":$A"&MAX(A:A)) függvény előállítja a teljes számsort a kezdő és végszám között egyesével (ha más lépésköz kellene, akkor Excel365-ben a SORSZÁMLISTA tudna segíteni).
A belső HOL.VAN megnézi hogy az előbb létrehozott számok az A-oszlopban hol találhatóak. Amelyik hiányzik ott hibát ad vissza, amelyet a SZÁM függvény HAMIS értékre fog lefordítani.
A külső HOL.VAN megnézi hogy hanyadik elemre kaptunk HAMIS értéket. Ezt a pozíciót hozzáadva a kezdőszámhoz megkapjuk hogy melyik hiányzott. -
#45334
Mutt
senior tag
m.zmrzlina
#45324
Mutt
senior tag
válasz
m.zmrzlina
#45324
üzenetére
Szia,
Most olvasva végig a leírásodat, ugyanazt csinálod amit én is javaslok és napi szinten használok. Nincs jobb megoldás, kivétel ha Office Script-re térnél át mert ott simán lehet tömbök méretét növelni.
2 megoldást tudok javasolni.
1. A kiTömb csak 1-dimenziós legyen és a beTömb indexét tartalmazza. Amikor pedig íratsz ki, akkor a kiTömb-ből kapott index-el a beTömb-ből olvasod ki az értékeket.
Memóriában nem fog sok helyet foglalni, lassitani sem igen fogja a feldolgozást, egyedül csak a kiírás lesz lassabb mivel nem tudod egy lépésben a tömb tartalmát kiírni. (Ez a megoldás nálam egy 3 percig futó makróból 2 percet vett el, szóval nem ideális ha sokat kell a lapon dolgozni. A 2-es opcióval gyors kiíratást elérsz, de oda kell figyelni a helyes indexek használatára!)2. Ne legyen probléma hogy a nem fixelt definiált tömbnek csak az utolsó méretét lehet változtatni. Képzeld el, hogy ez a tömb 90 fokkal el van forgatva az eredetihez képest. Az első sor innentől az első oszlopban lesz, a második sor a második oszlopban és így tovább. A kódod ilyenkor csak a hivatkozásban változik.
Az alábbi minta kód a kék listából kiszűri az adatot, egy dinamikusan változó tömbbe.
A sárga a dinamikus tömb eredeti (inverz) állapotát mutatja, de azt vissza lehet könnyedén konvertálni.
Sub ReDIM_Minta()
Dim minta As Range
Dim beTomb()
Dim kiTomb()
Dim oszlopok As Long, sorok As Long, i As Long, j As Long
Set minta = ActiveSheet.Range("A1").CurrentRegion
oszlopok = minta.Columns.Count
sorok = minta.Rows.Count
'erre nincs szükség, de látható hogy sorok és oszlopok szerint van a beTömb
ReDim beTomb(1 To sorok, 1 To oszlopok)
'adatok betöltése a tömbbe
beTomb = minta
'kiTomb-öt állítsuk be hogy annyi "sora" legyen mint az erdeti oszlop szám
ReDim kiTomb(1 To oszlopok, 1 To 1)
'az első sor a beTomb-ben egy fejléc másoljuk be a kitömb-be
For i = 1 To oszlopok
'itt látszik hogy csak az index sorrendet kell felcserélni
kiTomb(i, 1) = beTomb(1, i)
Next i
'szűréssel a nőket tartalmazó rekordokat tegyük be a kiTömb-be
For i = 2 To sorok
'ha a beTomb 4. oszlopában N van akkor
If beTomb(i, 4) = "N" Then
'növeljük a kiTomb utolsó dimenzióját 1-el
ReDim Preserve kiTomb(1 To oszlopok, 1 To UBound(kiTomb, 2) + 1)
'bemásoljuk az adatokat a beTomb-ből
For j = 1 To oszlopok
kiTomb(j, UBound(kiTomb, 2)) = beTomb(i, j)
Next j
End If
Next i
'konvertálatlan dump - sárga
ActiveSheet.Range("F1").Resize(UBound(kiTomb, 1), UBound(kiTomb, 1)) = kiTomb
'konvertált dump - zöld
ActiveSheet.Range("F10").Resize(UBound(kiTomb, 2), UBound(kiTomb, 1)) = Application.Transpose(kiTomb)
End Subüdv
-
Mutt
senior tag
válasz
lrobertoc
#45330
üzenetére
Szia,
Power Query-ben az "Elemi értékekre bontás" (angolul Unpivot) kell neked. Kijelölöd az első három fix oszlopot és, majd Átalakítás -> Többi oszlop elemi értékre alakítása opciót választod.
Ha a hónapokat tartalmazó szövegből pedig igazi dátumot akarsz, akkor kijelölöd az oszlopot és Átalakítás -> Dátum -> Elemzés (vagy ha új oszlopot akarsz akkor Oszlop hozzáadása -> Dátum -> Elemzés-t válaszd).
üdv
-
Fferi50
Topikgazda
válasz
lrobertoc
#45330
üzenetére
Szia!
Két "izgalmas" kérdés is van:
1. Hogyan lehet konvertálni a Munkatéri 2020. január stb. adatokat Ténybeli 2021. január stb. adatokká ...
2. Honnan szedjük a Munkatér táblában nem szereplő, de a Tény táblában ott levő tórzskód adatot a konvertáláshoz
Komolyra fordítva: Milyen szűrőként szeretnéd az időszak adatot használni a Munkatér táblában? Hiszen minden oszlop külön időszak, mit kell azon még szűrni?
PowerPivot és kimutatás nélküli konvertálás a Tény munkalapra:
Tény munkalap első sora marad.
A2 cellájába írd be a következő képletet:=ELTOLÁS(Munkatér!$A$2;MARADÉK(SOR()-2;DARAB2(Munkatér!$A$1:$A$1000)-1);OSZLOP()-1;1;1)
Ezt elhúzhatod lefelé és oldalra a D oszlopig.
Az E2 cellába írd be a következő képletet:=ELTOLÁS(Munkatér!$A$2;-1;3+INT((SOR()-2)/(DARAB2(Munkatér!$A$1:$A$1000)-1));1;1)
Ezt pedig lehúzhatod végig a sorokon.
Az eredmény minden dolgozó minden hónapi adata konvertálásra kerül ami a Munkatér táblázatban szerepel, a 0 értékek is.
A képletek működnek a szűrő használata esetén is.
Ha tovább szeretnél az adatokkal dolgozni, akkor célszerű értékké átalakítani a képleteket (másolás - irányított beillesztés értékként ugyanarra a területre).
Üdv. -
#45331
Fferi50
Topikgazda
m.zmrzlina
#45328
Fferi50
Topikgazda
válasz
m.zmrzlina
#45328
üzenetére
Szia!űjEsetleg csak a feltétel tartományokat beolvasni:
Arra gondoltam, hogy csak azokat az oszlopokat olvasd be külön-külön tömbökbe, amelyekre a feltételt meg kell vizsgálni. Így lesz 2-3 (esetleg több) egydimenziós(nak tűnő) tömböd, amelyeknek azonos sorában lesznek az egy sorhoz tartozó vizsgálandó elemei, tehát egy ciklussal elég végigmenni a vizsgálat során.
A feltételnek megfelelő sorok számát egy szövegváltozóban gyűjteném összePe Pl.dim sorkell as stringsorkell="1:1"sorkell=sorkell & ",5:5")sorkell=sorkell & ",9:9")
Persze ezeket a feltétel megfelelősége esetén.
A hasonlítás megtörténte után pedig:Sheets(forrás).Usedrange.Range(sorkell).Copy Sheets(eredmény).Range("A1")
egy lépésben átmásolja a teljes szűrt tartományt.
Üdv. -
lrobertoc
tag
Sziasztok,
egy kis segítséget kérnék a linkelt filehoz kapcsolódóan:
https://drive.google.com/file/d/1so_jXmVb64fvuajm3UgNpV75eOTgn5Na/view?usp=sharingA kérdés az lenne, hogy a "Munkatér" sheet-en lévő táblázatot pl. PowerQuery-vel át tudom-e alakítani a "TÉNY" sheeten lévő táblázat formátumára:
Igazából a problémám, hogy egy kimutatásban (pivot, poerpivot) a munktér táblázat adatstruktúrájában nem tudom az olszlopokban lévő "időszakot" filterként használni....
-
#45328
m.zmrzlina
senior tag
Fferi50
#45326
m.zmrzlina
senior tag
válasz
Fferi50
#45326
üzenetére
TextToColumns megoldás: ez érdekes, ki fogom próbálni.
AdvancedFilter függvény: lehet ez a legegyszerűbb erre nem is gondoltam
Esetleg csak a feltétel tartományokat beolvasni: ezt nem igazán értem. A bemenő tömbbel nincsen gondom, a kiíráshoz viszont a bemenő tömb sorának minden eleme kell. -
#45327
marec1122
senior tag
m.zmrzlina
#45325
marec1122
senior tag
válasz
m.zmrzlina
#45325
üzenetére
köszi
-
#45326
Fferi50
Topikgazda
m.zmrzlina
#45324
Fferi50
Topikgazda
válasz
m.zmrzlina
#45324
üzenetére
Szia!
Mi lenne, ha a kimenő tömböt csak 1 dimenziósra definiálnád. Ez a dimenzió így dinamikusan növelhető. Az elemeket elválasztójellel olvasnád be a tömb adott helyére.
Amikor kész vagy, akkor bemásolod az eredményt és az elválasztójel alapján a szövegből oszlopok (TextToColumns) függvénnyel tennéd át az oszlopokba az adatokat.
Persze kérdés, hogy ez mennyivel változtatja meg a futásidőt.
Esetleg csak a feltétel tartományokat beolvasni - akár külön-külön tömbbe - és akkor csak egy ciklusváltozó kell a vizsgálathoz.
Üdv.
Ps. Talán az AdvancedFilter függvény is érdekes lehet. -
#45324
m.zmrzlina
senior tag
m.zmrzlina
senior tag
Kétdimenziós dinamikus tömbökkel kapcsolatban lenne elméleti kérdésem. Gyakori feladat, hogy nagyobb adattartományokból (pl 10-20 000 sor 5-10 oszlop)kell bizonyos feltételek szerint kiválogatni egyes rekordokat. Én ezt úgy szoktam csinálni, hogy csinálok két tömböt. (pl beTömb, kiTömb)A bemenő tartományt beolvasom a beTömb-be amin azután végigmegyek egy For-Next ciklussal, és ha a kívánt feltétel teljesül azt a rekordot hozzáadom a kiTömb-höz. Ezt úgy teszem hogy előbb a Redim Preserve utasítással megnövelem a kiTomb méretét, majd ezt az új üres tömbelemet feltöltöm adattal.
A probléma itt kezdődik, mivel 2D dinamikus tömbnek nem lehet növelni a sorainak csak az oszlopainak számát. Ezt pl itt olvastam de számos más helyen is ugyanezt találtam. Ezért aztán egy eléggé nyakatekertnek lászó megoldást eszeltem ki. A kimenő tömbhoz hozzáadok egy oszlopot (Redim Preserve.....) ezt az oszlopot feltöltöm a beTömb sora adatával. Így kvázi egy transzponált tömböt kapok amit amikor kiíratok a munkalapra akkor a:
célmunkalap.Range(ahovárakniakarom).Value = Application.Transpose(kiTomb)
sorral itatom ki. Vagyis újratranszponálom a kapott kiTömb-ötAz a kérdésem, hogy lethet-e ezt a feladatot egyszerűbben csinálni, illetve, hogy milyen más megoldások léteznek?
-
#45321
Delila_1
veterán
pero19910606
#45320
Delila_1
veterán
válasz
pero19910606
#45320
üzenetére
If Cells(i, 11) = "Nincs nyitott kérdés" Then
If Cells(i, 6) = "Készletszint=0" Then
If Cells(i, 13) = "Van lemondási ok" Then
Cells(i, 14) = "Folyamatos hiány"
Else
Cells(i, 14) = "Beszerzői probléma"
End If
Else
Cells(i, xx) = "Készletszint köv.beérk. nap"
Cells(i, xy) = "Rendben"
End If
End If -
#45320
pero19910606
csendes tag
pero19910606
csendes tag
Sziasztok!
Macro-hoz szeretnék egy kis segítséget kérni Tőletek.
Több változós kritérium rendszer alapján szeretnék megírni egy macrot. Alap műveltekkel és néhány logikai változós kódot írtam már, de itt most egy elég összetett problémát szeretnék megoldani.
Készítettem egy folyamatábrát, remélem nagyjából érhető így, most először csináltam ilyet.A cél ugye az, hogy minden feltételt megvizsgálva eljussak az eredményig.
Az első eset:
Nincs nyitott rendelés, Készletszint = 0, Van lemondási ok --> "Folyamatos hiány"VBA: (Idézőjelek közé írtam most hogy az adott cellában milyen érték lenne, egyébként ott csak számok vannak)
If Cells(i, 11) = "Nincs nyitott rendelés" And Cells(i, 6) = "Készletszint = 0" And Cells(i, 13) ="Van lemodnási ok" Then
Cells(i, 14) = "Folyamatos hiány"Ez így egyszerű, könnyen meg van az eredmény, azonban összsen 5 elágazásom lenne, és az elágazásokban is többszörös elagázások szerepelnek, így külön kellene megírnom mindet.
Ezt így kellene megírni? Mert így ez egy logikai műveletek--> Ha az első igaz és a következő igaz és utána is igaz, akkor lesz eredmény.
Ha viszont valamelyik feltétel nem igaz, akkor ezzel a módszerrel külön meg kellene írnom ezt a sort.
Az Elseif-el kombinálva gondoltam, de egylőre nem járok sikerrel.Az lenne a jó, hogy alábbi módon fusson le a macro
1. lépés: van e nyitott rendelés? ha nincs
2. lépés : Van e készlet? Ha van
3. lépés: Elegendő e a következő beérkezésig? Ha igen --> "Minden ok"Majd kezdje előről a következő terméknél:
1. lépés: van e nyitott rendelés? Ha nincs
2. lépés : Van e készlet? Ha nincs
3. lépés: Van e lemondási ok? Ha igen --> "Folyamatos hiány"Köszönöm a segítséget!
Üdv! -
#45317
pero19910606
csendes tag
pero19910606
csendes tag
.
-
Fferi50
Topikgazda
válasz
D4rkm4n
#45315
üzenetére
Szia!
Kicsit macerás, de az alábbi lépésekkel megoldható:
1. Az A oszlop cellaegyesítéseit szüntesd meg.
2. A cégnevekkel töltsd ki a termékek mellett üresen maradt cellákat az A oszlopban lehúzással.
3. Az A-B oszlopot rendezed az A szerint.
4. Az A oszlopba visszateszed a cellaegyesítéseket - ekkor az egyesített cellákban csak az első név fog megmaradni.
Így visszajutottál a kiinduló állapotodhoz, rendezett céges listával.
De kérdés az, miért jó ez így neked, hiszen az egyesített cellákat nem tudja rendesen kezelni az Excel.
Talán érdemesebb lenne meghagyni a cégneveket minden A oszlopbeli cellában és akkor nem lenne ilyen gondod.
Üdv. -
D4rkm4n
őstag
Sziasztok!
Az alábbi küzdelemben kérném a segítségeteket!
A oszlopban 2-7. sorban hat cella egyesítésével szerepel egy cég neve. B oszlopban 2-7 sorban egy-egy termék neve, ami az adott cég megvásárol.
A oszlopba a 8-10 sor egyesítésével egy másik cég neve szerepel, tőle jobbra, a B oszlopban ahogy az imént, a 8. a 9. és 10. sorban szerepel egy-egy termék neve.A problémám az, hogy nem tudom az A oszlopban szereplő cégeket ABC sorrendbe tenni, mert nem egy méretűek. És azt sem tudom beállítani, hogy az Excel "tudja", hogy az egyesített celláktól jobbra található adatok ehhez a cellához tartoznak.
Valami ötlet?
-
#45313
dellfanboy
őstag
dellfanboy
őstag
van egy excel file-om ami arrol szol, hogy van egy havi adatmennyisegem kb 20-30 ezer sor20oszlopal oracle-bol. honaprol honapra novekszik. a lenyeg hogy a 20 oszlopon felul van 5 amit manualisan tolt ki a szamvitel.
a problemam hogy a file merete igy ev vegere tul nagy megynitas is percekig tart. van otletetek, hova/hogy tudnam meggyorsitani a file-t? jelenleg nem sok formula van benne minden ertekkel szerepel..
powerpivot mukodhet? vagy ms access? a lenyeg, hogy mas emberek is tudjanak updatelni kb 5oszlopot ugy hogy latjak a 20oszlopot(vagy ha nem is mind a 20-at par kulcs oszlopot).(ha jol remlik besorolgatnak vmi szamlakat vendorok alapjan..)
-
chigisch
újonc
Szia! Segítséget kérnék, bár lehet, egyszerű a megoldás, de nem jövök rá!
Adott egy táblázat 2 oszlopa, a w-ben vagy van érték, vagy nincs. Ha nincs, akkor a cella üres. Az x. Oszlop mindig hozzáadja az utolsó nem üres cella értékéhez a w. Oszlopban szereplő értéket.
Az w. Oszlop üres értékeinek problémája miatt a =HA(W6="" ;"" ;X5+W6) függvényt használom, viszont ez nem veszi figyelembe, ha történetében az x5 üres cella, így nem göngyölíti az x oszlopban szereplő értéket. Hogyan lehetne úgy kiegeszíteni a függvényt, hogy ha több üres w-x cella esetén a göngyölített adatnál az utolsó x oszlopban szereplő értéket vegye figyelembe?
Köszönöm szépen! -
Mutt
senior tag
válasz
woolwich
#45303
üzenetére
Szia,
Nyiss egy üresl Excel fájlt és hivatkozz a másik fájl cellájára benne.
Ez a cella értéket (formátum és képletek nélkül) fogja megjeleníteni, még a rejtett cellákon/oszlopokon/sorokon is működik.Ha a rögzítést kiveszed a hivatkozásból, akkor másolva a képletet gyorsan megkapod a másik fájl tartalmát.
üdv
-
Mutt
senior tag
válasz
zsolti_20
#45297
üzenetére
Szia,
A Connection only visszatöltés során az eredmény nem fog megjelenni egyik lapon sem, de az eredmény használható további lekérdezésekben, kimutatásokban. Az ilyen (és minden más) betöltés továbbra is szerkeszthető marad. Adatok (Data) fülön a Lekérdezések és kapcsolatok (Queries and Connections) gombot használva láthatód az összes lekérdezést és ott jobb klikkel tudod szerkesztésre megnyitni.
üdv
-
woolwich
tag
Sziasztok,
Van egy Excel file, amelyhez csak bizonyos accounttal rendelkező személyek férhetnek hozzá (az vagyok), illetve semmit, de tényleg semmit nem tudnak vele kezdeni.
Na most a tábla 32K soros, így elég nehéz belőle konklúziókat levonnom szűrések stb. nélkül.
Másolni nem lehet belőle, 3rd party converterek hibára futnak. Egyedül nyomtatni tudom .pdf-be és onnan tudnám visszamenteni .xls-be, de valamiért az is hibára fut.Bármi ötlet hogy lehet megkerülni ezt a lockot?
Tudom, hogy okkal van rajta, de hiába van hozzáférésem, semmit nem tudok vele kezdeni ebben a formában. -
Magnat
veterán
válasz
zsolti_20
#45300
üzenetére
Szia
csinálsz egy formot (Userform1), rá egy Listboxot (Listbox1), aztán:
Sub Popup()Dim cel As RangeDim selectedRange As RangeSet selectedRange = Application.SelectionUserForm1.ListBox1.ClearFor Each cel In selectedRange.CellsUserForm1.ListBox1.AddItem (cel.Value2)Next celUserForm1.ShowEnd SubEz a szelektált cellák tartalmát fogja bedobni a Listbox1-be.
Szerk.: Ha legördülő kell, akkor Listbox helyett Combobox kell.
Szóval MS-ék ezt direkt így csinálták....
) Nagyság szerint a legnagyobb áll elöl a legkisebb hátul. A második legnagyobb gyerek a sorban a második. Nálad ez az 55 és a 15 ez rendben van. A legkisebb áll hátul, a második legkisebb előtte eggyel. Nálad a legkisebb a 4 ez oké, a második legkisebb szerintem a 7.
Új hozzászólás Aktív témák
- Motorolaj, hajtóműolaj, hűtőfolyadék, adalékok és szűrők topikja
- REpont és hulladékgazdálkodás
- Valósággá vált a Tecno szupervékony telefonja
- Xbox Series X|S
- World of Tanks - MMO
- Mini PC
- Trollok komolyan
- Samsung Galaxy S25 - végre van kicsi!
- Linux kezdőknek
- Counter-Strike: Global Offensive (CS:GO) / Counter-Strike 2 (CS2)
- További aktív témák...
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Játékkulcsok a legjobb áron: Steam
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- Vírusirtó, Antivirus, VPN kulcsok
- REFURBISHED - HP USB-C Dock G4 docking station (L13899-001)
- Dell Latitude 5320 i3-1125G4 16GB 512GB magyarbill. 1 év garancia
- Lenovo ThinkPad P1 G7
- Tablet felvásárlás!! Samsung Galaxy Tab A8, Samsung Galaxy Tab A9, Samsung Galaxy Tab S6 Lite
- 3DKRAFT.HU - 3D NYOMTATÁS - AZONNALI ÁRAJÁNLAT - GYORS KIVITELEZÉS - 490+ POZITÍV ÉRTÉKELÉS
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest