-
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
-
zz76zz
csendes tag
válasz
cousin333
#14098
üzenetére
Ez nagyon szép megoldás. Köszönöm szépen! Nem ismertem ezen lehetőségeket. Már csak annyi gondom van, hogy a scrip futtatása köznem a dátumokat átformázza és katyavaszos lesz. Hiába raktam át szövegessé a cellákat, amikor a script nekikezd, akkor átnézi újra és átírja. Olvastam fórumokat, de kielégítő megoldást nem találtam. . . ha valaki tud segíteni megköszönöm.
OO nem rakja át ott viszont nem működött egyik függvény sem. -
cousin333
addikt
válasz
hallgat
#14093
üzenetére
Na, megalkottam a gyilkos VBA kódot
Nyilván lehetne még rajta reszelni, de úgy tűnik, működik, méghozzá elég gyorsan. A kód feltételezi, hogy a kérdéses számok az A1:A20000-es tartományban vannak. Akkor is így kell megadni, ha a számok csak a 2. sorban kezdődnek! Ha nem az első sorból indítasz, akkor módosítgatni kell a kódot, mert nálam a tartomány indexe és a sor száma ugyanaz (lásd a For ciklust).Gyakorlatilag megnézem a teljes listát, és ha azonosat találok, megjelölöm azzal, hogy törlöm a mellette(!) lévő cella tartalmát (különben csak minden 2. egyezést találna meg). A törlést nem a munkafüzeten végzem, mert az ennyi adatnál lassú lenne, hanem "belsőleg".
Ezután fogom a teljes tartományt, és kijelölöm illetve törlöm azokat a sorokat, amiben a B cella üres. A kód:
Sub duplikatum()
Dim szamok As Variant
szamok = Range("A1:B20000").Value
sorok = ""
For i = 2 To UBound(szamok)
If szamok(i, 1) = szamok(i - 1, 1) Then
szamok(i, 2) = ""
End If
Next i
Range("A1:B20000").Value = szamok
Range("B1:B20000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub -
cousin333
addikt
válasz
hallgat
#14093
üzenetére
Mindenképpen az egész sor törlése kell, nem csak egy adott mennyiségű oszlopé?
A sebesség azért lassú, mert sokszor nyúlsz a cellákhoz. Ilyen adatmennyiségnél ez már komoly problémát jelent.
Azt írtad, hogy az ismétlődések csak egymás után fordulnak elő. Akkor egyszerűen menj végig az oszlopon, és ha az aktuális cella megegyezik az előző cellával, akkor töröld ki az adott sort. Csak arra figyelj, hogy legközelebb is ugyanezt a sort vizsgáld, mert a törlés miatt eggyel kevesebb lett. Vagy alulról indulj el felfelé.
-
cousin333
addikt
válasz
zz76zz
#14092
üzenetére
Javaslom, hogy ilyenkor próbálj ki két dolgot: a képletkiértékelőt, ahol lépésről lépésre láthatod, hogy hogyan számol, illetve az egyes függvények súgóját.
Azért nem működik, mert "Ha a keres_szöveg értéke nem található, a függvény az #ÉRTÉK! hibaértéket adja eredményül."
A megoldást pl. a HAHIBA függvény jelentheti.
A másik, hogy ilyen logikai vizsgálatnál az egymásba ágyazott HA függvényekkel csak a saját életedet bonyolítod. Mi van, ha még egy feltételt teljesíteni kellene? Javaslom a VAGY függvény használatát, amivel a képleted így nézne ki:
=--VAGY(A1="n"; A1="item";HAHIBA(1=SZÖVEG.KERES("2012*"; A1;1); 0))
A két mínuszjel azért van az elején, mert a VAGY függvény kimenete IGAZ vagy HAMIS, ezzel a művelettel viszont 1 ill. 0 lesz belőle. Egyébként írhatnád úgy is, hogy
=(A1="n")+(A1="item")+HAHIBA(1=SZÖVEG.KERES("2012*";A1;1);0)
-
#90999040
törölt tag
válasz
hallgat
#14093
üzenetére
Próbáld meg így:
n = Range("A" & Rows.Count).End(xlUp).Row
For i = n - 1 To 1 Step -1
If Cells(i, 1).Value <> Cells(n, 1).Value Then
If i < n - 1 Then Rows(i + 1 & ":" & n - 1).Delete
n = i
End If
Next
If Cells(1, 1).Value = Cells(n, 1).Value And n > 1 Then Rows(1 & ":" & n - 1).Delete -
hallgat
csendes tag
válasz
saab00
#14079
üzenetére
Szia!
1., SzumHa függvényt nézd meg. Az egy rendszámhoz tartozó értékeket összeadja neked.2., FKeres nem fog menni, az első találatot fogja adni
3., Ha a találat alatti cella értéke kell, azt meg tudod oldani a HOL.VAN fügvénnyel (ezzel megkeresteted az értéket, majd megadod, hogy a következő sor azonos oszlopából vegye az értéket. Viszont itt is baj lesz az ismétlődésekkel...
-
hallgat
csendes tag
Sziasztok!
Küzdök egy ideje az azonos soraim törlésével, de nem akar összejönni, vagy iszonyú hosszú ciklusidővel dolgozik (és még az is hibásan
)A táblázatom "A" oszlopában a 2. sortól a végéig számok vannak.
A számok között van ismétlődés, de azok mindig egymás után következnek, szám szerint 19 alkalommal/szám.Azt szeretném elérni, hogy az utolsó sort meghatározva, ("A" & usor)- tól felfelé haladva végezze el az ismétlődő sorok törlését.
Tehát pl. vizsgálja meg, hogy "A17777" cella értéke azonos e "A17776" értékével és ha igen, akkor törölje ki a 17776. sort, majd ismét vizsgálja meg, hogy "A17777" cella értéke azonos e "A17776" értékével, ha azonos akkor megint sortörlés, ha nem, akkor ugorjon 1 cellát felfelé és vizsgálja meg, hogy "A17776" értéke azonos e "A17775" értékével, ha igen sortörlés, ha nem, akkor ugrás egyel feljebb.
Nem másolok be kódrészletet, mert már nagyon szétfaragtam amiket innen onnan szereztem a célra és nem is működnek, így nem nagyon van értelme
Az egyetlen, ami futott, az egy cella értéket végigvizsgált a teljes tartományon (30-40 ezer sor) majd törölte az azonosakat, aztán kezdte a következő cellával elölről. Egyrészt eszméletlen lassú, másrészt a törlés sem volt tökéletes, mert a sorok törlése miatt felülről haladva lefelé, csak egy részét távolította el az ismétlődéseknek, ha azok egymást követő sorokban voltak (már pedig mind így ismétlődik, 19x egymás alatt)
Előre is köszönöm a segítséget!
-
-
utgyuru
aktív tag
Sziasztok!
Egy ilyen táblázatot szeretnék csinálni, aminek az első sorában az év, másodikban, a hónap, harmadiknak a napok vannak. Úgy kellene, hogy az év össze van vonva, meg a hónap is, de nem kézzel vonom össze. Ez megoldható? Ha mondjuk 10 évvel csinálnám, elég sokáig tartana. A hétvégék napjait meg színnel szeretném kiemelni. Valaki ebben tudna segíteni?
-
#14087
zz76zz
csendes tag
Bocimaster
#14084
zz76zz
csendes tag
válasz
Bocimaster
#14084
üzenetére
Az a baj, hogy ha szöveggé konvertálod át a cellákat, akkor viszont nem tudod formázni.
3 külön cellába tudod tenni, de az nem túl szép megoldás.
Esetleg beviteli mezőket alkalmazhatsz. . . bár jó lenne pontosan tudni mi a feladat. -
Fecdzo
senior tag
Sziasztok!
Egy olyan problémát szeretnék megoldani, hogy adott két email lista. Ezeket szeretném összehasonlítani, úgy, hogy kiemelje vagy tegyen 1-est azon email címek mellé, amelyek benne vannak a nagyobb táblázatban és nullát amellé amelyik nem szerepel. Hogyan tudnám ezt megoldani?
-
#14081
zz76zz
csendes tag
Bocimaster
#14044
zz76zz
csendes tag
válasz
Bocimaster
#14044
üzenetére
Az a baj, hogy azt nem fogadja logikailag el, hogy
A1="2012*"
mert ugyan a többi feltétel egzakt a harmadik ha feltétel a 2012 vel kezdődő adatokat is igaznak kellene vennie. . . -
saab00
csendes tag
"Egy olyan kérdésem lenne hogy hogyan lehet azt excelben(2003) megoldani, hogy van egy táblázatom napi dátummal,hónap, rendszámmal(összevissza), km stb.......és egy másik táblázatba a rendszám(sor)hoz és a hónap(oszlop)-t figyelembe véve összegezze az előző táblázatból az adatokat (pl. a km-t) (ugye egy rendszám többször is előfordul egy adott hónapban) ...vagyis hogy ne kelljen kétszer beírni ugyanazt az adatot de rendszám és hónap alapján szűrje és összegezze az értékeket !?
--
-
És még egy: az fkeres fügyvénynél be lehet azt állítani h a keresési tartományban(ami nincs alapból sorba rendezve) ha több találat van csak a legutolsót vegye figyelembe ill. h pl.a 3. oszlopban az egy sorral lejjebb lévőt adja eredményül ??"
-
-
Erre esetleg valaki valami megoldás ???? -
#90999040
törölt tag
válasz
detroitrw
#14038
üzenetére
Szerintem nem annyira értelmezhetetlen.
Egy sor -> egy szálat jelent. Pl. a fejléc a konkrét esetben:
2427 2359 946 900 430 410 Hulladék Teljes Max darab
Az egyik sor pedig:
0 0 0 2 5 5 0 * 1
Ez ezt jelenti egy szál esetén:
0*2427 + 0*2359 + 0*946 + 2*900 + 5*430 + 5*410 = 6000Értelemszerűen a hulladék 0%. Teljes oszlopban a * azt jelenti, hogy erre a szálra már a legrövidebb(410 mm-es) darab sem férne rá.
A max darab ebből a szálból azért 1, mert ha pl. 2 lenne, akkor már a 430 mm-esből 10 darab jönne ki, holott összesen csak 6 darab kell belőle.Az adott linken levő programot fogalmam nincs, hogy lehetne működésre bírni(már csak azért sem, mert amit meg tudok csinálni, abból a legritkább esetben használok kész programot). De más talán majd megnézi...
Viszont még az elején említettem a random generálást. Ezt kipróbáltam. Ha 20 szálra keresek, akkor nagyon rövid idő alatt kidob egy lehetséges megoldást. Ha erre lecseréled az előző makrót, akkor láthatod az eredményt.
Sub frissit()
Set cel = Range("D1")
Range("D1:V" & Rows.Count).ClearContents
korrekcio = 1
maxprobalkozas = 10000000
talalatszam = 0
sor = cel.Row
oszlop = cel.Column
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
hosszok = Application.Transpose(Range("A2:A7"))
szalhossza = Range("A10").Value
darabok = Application.Transpose(Range("B2:B7"))
osszdarab = 0
osszhossz = 0
For i = 1 To UBound(darabok)
osszdarab = osszdarab + darabok(i)
osszhossz = osszhossz + hosszok(i) * darabok(i)
Next
mindarab = Application.RoundUp(osszhossz / szalhossza, 0)
ReDim tomb(0 To osszdarab - 1)
aktindex = 0
For i = 1 To UBound(darabok)
For j = 0 To darabok(i) - 1
tomb(aktindex) = hosszok(i)
aktindex = aktindex + 1
Next
Next
'kezdődik a tippözön :)
Randomize
For i = 1 To maxprobalkozas
For j = 0 To UBound(tomb)
R = Int((osszdarab) * Rnd())
R1 = Int((osszdarab) * Rnd())
If R <> R1 Then
temp = tomb(R)
tomb(R) = tomb(R1)
tomb(R1) = temp
End If
Next
szalakszama = 0
akthossz = 0
temphossz = 0
For j = 0 To UBound(tomb)
If akthossz + tomb(j) = szalhossza Then
temphossz = temphossz + akthossz + tomb(j)
akthossz = 0
szalakszama = szalakszama + 1
ElseIf akthossz + tomb(j) > szalhossza Then
temphossz = temphossz + akthossz
akthossz = tomb(j)
szalakszama = szalakszama + 1
Else
akthossz = akthossz + tomb(j)
End If
Next
If temphossz < osszhossz Then szalakszama = szalakszama + 1
If szalakszama <= mindarab + korrekcio Then
talalatszam = talalatszam + 1
akthossz = 0
aktoszlop = oszlop
s = ""
For j = 0 To UBound(tomb)
If akthossz + tomb(j) = szalhossza Then
akthossz = 0
Cells(sor, aktoszlop) = tomb(j)
sor = sor + 1
aktoszlop = oszlop
ElseIf akthossz + tomb(j) > szalhossza Then
akthossz = tomb(j)
sor = sor + 1
aktoszlop = oszlop
Cells(sor, aktoszlop) = tomb(j)
aktoszlop = aktoszlop + 1
ElseIf j = UBound(tomb) Then
Cells(sor, aktoszlop) = tomb(j)
aktoszlop = aktoszlop + 1
Else
Cells(sor, aktoszlop) = tomb(j)
aktoszlop = aktoszlop + 1
akthossz = akthossz + tomb(j)
End If
Next
sor = cel.Row + talalatszam * (mindarab + korrekcio + 1)
aktoszlop = oszlop
Exit Sub
End If
Next
End SubAz elején a korrekcio = 1 állítja be, hogy nem az elméleti minimális szálmennyiségre akarunk keresni, hanem 1-el többre(jelen esetben 20-ra).
Nálam ez nagyon gyorsan beleszalad egy lehetőségbe.
Persze még van rajt bőven finomítanivaló, de ezek már csak részletkérdések. A Exit sub miatt kilép az első találat után, ha ez nincs benne, akkor többet is keres, egészen a maxprobalkozas-ig. Valószínűleg nincs szükség annyi random számra, amennyi a tomb elemeinek a száma->ezt ki lehet tapasztalni... -
Ndrew8647
csendes tag
válasz
föccer
#14074
üzenetére
Értem.
Marad a cikkszámos megoldás, mert rájöttem közben, hogy hiába van a cikkszám fele beírva, azt látni fogja a másik táblázatomban, mert abban viszont nem úgy van hogy 111-114 hanem 111 - fehér 112 - piros stbstbstb szóval látni fogom és emiatt ki is tudom gondolom szűrni.De ehhez nem is kell cikkszám szerint rendeznem gondolom.
A keresésénél ill. az összehasonlításnál megoldható a módszereddel az, hogy nem soronként nézi át hanem összehasonlítja A oszlopot a másik tábla A és/vagy B oszlopával?
Mert akkor gondolom ez lenne a kézenfekvő megoldás.
Az üres mezőbe beírom a függvényt, amiben összehasonlítom X munkalap A oszlopát Y munkalap A vagy B oszlopával és ha egyenlő akkor ír egy X .-et.Sejtem így kellene ezt megoldani, csak már én is annyira fáradt vagyok, hogy nem jár az agyam.
Csak maga a függvény leprogramozás része nem megy
-
föccer
nagyúr
válasz
Ndrew8647
#14067
üzenetére
Vagy a termék neveket hasonlítjuk össze, vagy a cikkszámokat. Ezt neked kell eldönteni. Ha csak a cikkszámokat, akkor a példánál maradva csak a kék színű sapkák lesznek összehasonlítva, míg ha csak terméknév alapján, akkor az szívás és most így 1/2 12-kor nem vállalom.
üdv, föccer
-
föccer
nagyúr
Valamiért a hibakezelés nem akar működni, de mndegy, a célnak így is megfelel.
B1-be
, ha A oszlopban vannak az adatok:=HA(SZÖVEG.KERES("adat2";A1)>0;"Talált!";"Nincs találat!")
Ezután autoszűrő bekapcsol, leszűrsz a "Talált kifejezésre a B olszopban, majd copy-paste az új munkalapra.
üdv, föccer
-
Pá
addikt
válasz
föccer
#14066
üzenetére
Hogyan?
Azt szeretném, hogy vízszintesen legyen félbevágva az excel tábla és ha a munkalapokat váltogatom, akkor csak az alsó ablak cserélődjön a felső legyen fix.
Most ha félbevágom a táblát, az csak az adott munkalapra vonatkozik és ha a tabon váltok, akkor kapok egy új, nem félbevágott lapot. -
Ndrew8647
csendes tag
válasz
föccer
#14066
üzenetére
Így van ahogy mondod. A dolgot csak az bonyolítja, hogy tegyük fel egyik munkalapon van 111-115 cikkszámon futó sapka, míg a másik munkalapon ugyan ez a termék csak a 114-es számon fut, mert az pl a kék színű, de maga a termék ugyan az.
Tehát gondolom a cikkszám alapján így nem lehet meghatározni nem? -
föccer
nagyúr
válasz
Ndrew8647
#14063
üzenetére
Akkor elég csak cikkszám alapján összehasonlítani, mert ahogy kiveszem a szavadból, több cikkszám van, mint termék. Tehát 1 termékhez tartozhat több cikkszám, de 1 cikkszámhoz nem tartozhat több termék.
Pá:
Ha két munkalapról van szó, akkor ez elvileg gond nélkül mennie kellene.
-
Ndrew8647
csendes tag
válasz
föccer
#14059
üzenetére
A sorba rendezés az a cikkszám szerint van.
A két táblázat viszont sajnos eltérő lehet és nem minden cikkszám egyezik meg azonos termékeknél. mert a méretek miatt többféle lehet és sajna a felvitelnél nem ugyan úgy került rögzítésre.Emiatt gondoltam az ár alapján kellene ellenőrizni, mert elég kevés egyéb kategóriába sorolt termék ára lesz azonos.
-
Ndrew8647
csendes tag
válasz
föccer
#14057
üzenetére
Köszi, küldök máris egy képet...
De leírom, hogy pontosan hogy is gondoltam.
Van két táblázatom ugyan azokkal a termékekkel.
De a két táblázatban az árak eltérőek azonos termékeknél.
Viszont nem mindenhol, és nekem ezt ki kellene szűrnöm, hogy ahol egyezik az ár a két táblázatban ugyan annál a terméknél, ott jelölve legyen a sor.
A termékek a két listában nem ugyan olyan sorrendben következnek sajnos, de rendezve vannak azonosító szerint.
Csak egyikben több másikban kevesebb van, ezért eltérő a darabszám és a sorrend.
De a termékek ugyan azok. -
Ndrew8647
csendes tag
Szép estét mindenkinek!
Sajnos kicsit kakukk vagyok az excel függvényeihez és segítségeteket szeretném kérni, hogy van két táblázatom árakkal, termékek neveivel és azonosítókkal.
Hogyan tudom azt kiszűrni, hogy a két táblázatban szereplő termékeknél melyiknél egyezik az ár.
Tulajdonképpen azt kellene megoldani, hogy ahol az ár megegyezik ott valamivel jelölje azt a mezőt. a legcélszerűbb az lenne, hogy a mellette levő oszlopba egy X jelölést vagy bármilyen karaktert tegyen, amivel később rendezni tudom, hogy a jelölt sorok kerüljenek a táblázatom elejére.Hogyan tudom ezt megoldani anélkül, hogy végig kellene néznem kb. 5000 sort és egyenként összehasonlítani az adatokat?
Kérlek, hogy aki tud segítsen benne,
Köszönettel:
András
-
#14049
zz76zz
csendes tag
Bocimaster
#14048
zz76zz
csendes tag
válasz
Bocimaster
#14048
üzenetére
Bankszámlaszám csak 3*8 vagy 2*8 jegy lehet. Ha 2*8 akkor ki kell egészíteni 8db 0 val
-
bozsozso
őstag
Sziasztok,
Szeretnék makróban olyat csinálni, hogy egy adott oszlopban adott szöveget keressen meg és ha megtalálta akkor a ennek a sornak az összes adatát másolja át mondjuk az adatok munkalap 2.sorába majd keresi a következőt ha megvan az meg mehet a következő sorba. Makrórögzítéssel megcsináltam auto szűrő majd másol beilleszt a megfelelő helyre, de nincs ettől jobb, "elegánsabb" megoldás? Valamint esetleg olyat, hogy ha az oszlopban amiben keresek bármi módosítás történik akkor legyen végrehajtva a makró?
Pl.:Érték1 jó 5,00
Érték2 rossz 10,00
Érték3 nagyon rossz 15,00
Érték4 jó 48,00Szeretném ahol jó szerepel az kerüljön át az adatok munkalapra a 2. sortól kezdődően.
Érték1 jó 5,00
Érték4 jó 48,00Előre is köszönöm a segítséget.
-
#14045
zz76zz
csendes tag
Bocimaster
#14044
zz76zz
csendes tag
válasz
Bocimaster
#14044
üzenetére
Oké köszi holnap megpróbálom, hogy a makrorögzítő különböző táblákon, is "jól" viselkedik e.
-
#14044
Bocimaster
csendes tag
Bocimaster
csendes tag
Sziasztok!
Az volna a kérdésem, hogy hogyan tudom beállítani egy cellába -egyéni cellaformázással-a bankszámlaszám formátumát (3*8 szám, 2 kötőjellel elválasztva)?Előre is köszönöm.
-
zz76zz
csendes tag
Sziasztok!
Kezdő (illetve már elfelejtő) Excel VB író vagyok.
A kérdés az lenne, hogy egyáltalán kell e makró?A feladat kellemetlenül sok sorból kitörölni azokat az oszlopokat, amik nem felelnek meg bizonyos kritériumoknak.
A lényege ennek az lenne, hogy pdf ből áttesznek nagy sok sort és a gombnyomásra rendeződnének az adatok. Az oszlopszétszedés nem gond, makro rögzíti majd.
Egy laza ha függvénysorral le tudom szűkíteni, hogy mondjuk az adott megmaradni kívánt sorban van e egy x vagy sincs. (sgondolom a makrorögzítő ezt is veszi). De hogyan szabadulok meg úgy a többi sortól, hogy a sorrendem megmaradjon?
Vagy egyszerűbb lenne, ha mindent egy makro végezne?
Makro tud sort törölni bonyolult szövegbeni tartalmazódás szerint?
Túl sokat kérdezek?
Túl össze vissza? Bocs -
bugizozi
őstag
válasz
föccer
#14039
üzenetére
Sub Get_Data()
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to import", _
FileFilter:="Excel Files *.xls (*.xls),")
''
If FileToOpen = False Then
MsgBox "No file specified.", vbExclamation, "Duh!!!"
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
End If
End Sub -
föccer
nagyúr
Üdv!
Mivel tudom megoldani azt, hogy amikor makróbol akarok egy xls fájlt megnyitni, akkor az adott fájlt egy opendialog-ból lehessen kiválasztani.
Köszi,
üdv, föccer
mod:
Sub macro1()
Filter = "Excel files (*.xls),*.xls"
Caption = "Kérem, adja meg a fájl elérési útját!"
SelectedFile = Application.GetOpenFilename(Filter, , Caption)
ActiveSheet.Range("A1").Value = SelectedFile
End SubEz így elvileg működik?
üdv, föccer
-
saab00
csendes tag
Sziasztok !
Egy olyan kérdésem lenne hogy hogyan lehet azt excelben(2003) megoldani, hogy van egy táblázatom napi dátummal,hónap, rendszámmal(összevissza), km stb.......és egy másik táblázatba a rendszám(sor)hoz és a hónap(oszlop)-t figyelembe véve összegezze az előző táblázatból az adatokat (pl. a km-t) (ugye egy rendszám többször is előfordul egy adott hónapban) ...vagyis hogy ne kelljen kétszer beírni ugyanazt az adatot de rendszám és hónap alapján szűrje és összegezze az értékeket !?
--
-
És még egy: az fkeres fügyvénynél be lehet azt állítani h a keresési tartományban(ami nincs alapból sorba rendezve) ha több találat van csak a legutolsót vegye figyelembe ill. h pl.a 3. oszlopban az egy sorral lejjebb lévőt adja eredményül ??
-
Köszönöm ! -
#90999040
törölt tag
válasz
detroitrw
#14032
üzenetére
Egy új munkalapra másold át az A1 : B7 tartományt(hogy az új munkalapon is az A1 : B7-ben legyen. Az A10-be írd be a 6000-et(mert milliméterben számol).
ALT+F11, majd INSERT menü -> Module.
Ebbe a modulba másold be ezt:Sub frissit()
Set cel = Range("D1")
maxsordarab = 20000
sor = 1 + cel.Row
oszlop = cel.Column
eredetisor = sor
Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
hosszok = Application.Transpose(Range("A2:A7"))
szalhossza = Range("A10").Value
darabok = Application.Transpose(Range("B2:B7"))
vegsodarabok = Application.Transpose(Range("B2:B7"))
For i = LBound(vegsodarabok) To UBound(vegsodarabok)
vegsodarabok(i) = Application.Min(Application.RoundDown(szalhossza / hosszok(i), 0), darabok(i))
Next
ReDim kimenet(1 To maxsordarab, 1 To 9)
ossz = 0
osszeg = 0
teljes = 0
n = UBound(darabok) - 1
ReDim tomb0(0 To n)
q = -1
Do
While q < n
q = q + 1
tomb0(q) = 0
Wend
ossz = ossz + 1
tele = True
m = 0
For i = 0 To n
If tomb0(i) < darabok(i + 1) Then
If osszeg + hosszok(i + 1) <= szalhossza Then
tele = False
Exit For
End If
End If
Next
If tele Then teljes = teljes + 1
Dim maxdarab As Integer
maxdarab = 200
If tele Then
For i = 0 To UBound(tomb0)
m = m + hosszok(i + 1) * tomb0(i)
kimenet(1 + sor - eredetisor, 1 + i) = tomb0(i)
If tomb0(i) <> 0 Then
If Application.RoundDown(darabok(i + 1) / tomb0(i), 0) < maxdarab Then maxdarab = Application.RoundDown(darabok(i + 1) / tomb0(i), 0)
End If
Next
kimenet(1 + sor - eredetisor, 1 + i) = (szalhossza - m) / szalhossza
kimenet(1 + sor - eredetisor, 1 + i + 1) = "*"
kimenet(1 + sor - eredetisor, 1 + i + 2) = maxdarab
sor = sor + 1
Else
For i = 0 To UBound(tomb0)
m = m + hosszok(i + 1) * tomb0(i)
kimenet(1 + sor - eredetisor, 1 + i) = tomb0(i)
If tomb0(i) <> 0 Then
If Application.RoundDown(darabok(i + 1) / tomb0(i), 0) < maxdarab Then maxdarab = Application.RoundDown(darabok(i + 1) / tomb0(i), 0)
End If
Next
kimenet(1 + sor - eredetisor, 1 + i) = (szalhossza - m) / szalhossza
kimenet(1 + sor - eredetisor, 1 + i + 2) = maxdarab
sor = sor + 1
End If
Do While q > -1
If tomb0(q) < vegsodarabok(q + 1) Then
tomb0(q) = tomb0(q) + 1
osszeg = osszeg + hosszok(q + 1)
If osszeg > szalhossza Then
osszeg = osszeg - hosszok(q + 1)
tomb0(q) = tomb0(q) - 1
osszeg = osszeg - hosszok(q + 1) * tomb0(q)
q = q - 1
Else
Exit Do
End If
Else
osszeg = osszeg - hosszok(q + 1) * tomb0(q)
q = q - 1
End If
Loop
Loop While q > -1
sor = sor - 1
For i = 1 To 9
kimenet(1, i) = kimenet(1 + sor - eredetisor, i)
kimenet(1 + sor - eredetisor, i) = ""
Next
ActiveWindow.FreezePanes = False
Range(Cells(eredetisor - 1, oszlop), Cells(maxsordarab, oszlop + 8)).ClearContents
Range(Cells(eredetisor, oszlop), Cells(eredetisor + maxsordarab - 1, oszlop + 8)).Value = kimenet
Range(Cells(eredetisor - 1, oszlop), Cells(eredetisor - 1, oszlop + 5)).Value = Application.Transpose(Range("a2:a7").Value)
Cells(eredetisor - 1, oszlop + 6).Value = "Hulladék"
Cells(eredetisor - 1, oszlop + 7).Value = "Teljes"
Cells(eredetisor - 1, oszlop + 8).Value = "Max darab"
Cells(eredetisor, oszlop).CurrentRegion.Sort Key1:=Cells(eredetisor, oszlop + 6), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Cells(eredetisor, oszlop + 10).FormulaR1C1 = "=1+RC[-2]"
Cells(eredetisor + 1, oszlop + 10).FormulaR1C1 = "=(1+RC[-2])*R[-1]C"
Cells(eredetisor + 1, oszlop + 10).Copy Destination:=Range(Cells(eredetisor + 2, oszlop + 10), Cells(sor, oszlop + 10))
Cells(eredetisor, 1).Select
ActiveWindow.FreezePanes = True
End SubA makró elindítása után(itt arra figyelni kell, hogy az új munkalap legyen az aktív) a D:H oszlopokban megjelennek a darabszámok(a fejléc a hosszt tartalmazza). A J oszlopban a hulladék, a K oszlopban levő csillag azt jelenti, hogy az adott 6m-es szálra már a legkisebb(jelen esetben 410 mm-es) darab sem fér rá.
Az L oszlopban az adott szál maximális darabszáma szerepel.A legfontosabb: N oszlopban jelzi, hogy hány esetet kellene megvizsgálni - no ez az, ami miatt napok/hetek/évek kérdése, hogy mikor végezne az összes eset megvizsgálásával.
-
buherton
őstag
válasz
Delila_1
#14025
üzenetére
Ez idáig oké, de ezt hogyan tudom az összesre excel fájlra kiterjeszteni, hogy azok önállóan is tudjanak működni?
Közben van egy másik problémám is. Ezt "egyszerűen nem engedi bemásolni a cellába
.SheetNumberReport-ban 2 az érték, ami létezik.
ReportBook.Worksheets("Summary").Range(SheetNumberReport, "N") = "=IF(COUNTIF('CT alr. (Linux) - LT - 001'!H5:H31;Summary!Q2)='CT alr. (Linux) - LT - 001'!A5;Summary!Q2;Summary!Q3)"
A függvényt ha manuálisan másolom be, akkor jól működik!
-
válasz
cousin333
#14033
üzenetére
Szia!
köszi hogy foglalkoztál vele
bár azt nem tudom miként lehet automatizálásra bírni
meg ezt még át kéne írni hogy másnak is érthető legyeneddig ezt találtam [link]
elég komoly cucc s 1-2 esetbe kihozta kevesebb szálból
s nincs szükség gépelésre, copy&paste módszerrel fel lehet tölteni az adatot, ill az eredményt könnyen vissza lehet másolni
és még vágórést is meglehet adni
annyi hogy 60 napig ingyenes (na de akkor mire lenne jó a virtualpc?
)van egy másik is [link]
ezt viszont nem tudom beüzemelni -
cousin333
addikt
válasz
detroitrw
#14032
üzenetére
A sokféle lehetséges variáció miatt nem elhanyagolható a kézi módszer.
Én készítettem egy gépi változatot, ami a Solver funkcióra alapoz, és brute-force módszert használ: [link].
Persze igyekeztem minimalizálni a lehetőségeket számos korlátozás bevezetésével. Mindenesetre nálam gond nélkül futott egy órát, és még nem adott végleges eredményt. Igazából nem tudom, meddig futna...
Az egyes cellákat kicsit nehéz kibogarászni, mert a lehető legtöbb konkrét számot és a legkevesebb képletet szerettem volna felhasználni, így remélve azt, hogy gyorsul a számolgatás.
A lényeg, hogy az egyes sorokban látod a különböző elosztási típusokat (max. 5-öt), ahogy te is csináltad a kézi módszernél. A rendszer azt számítja, hogy melyik hosszból mennyit használjon, illetve az adott osztást hány lécen alkalmazza.
A Solver a maradék hosszok négyzetösszegét igyekszik minimalizálni, ami nem feltétlenül a legoptimálisabb cél, de talán nem okoz olyan nagy hibát.
-
válasz
#90999040
#14031
üzenetére
nem a legjobb megoldás lenne a lényeg, mivel kézzel se arra törekszek!
prioritás alapján megyek végig szal előre kerülnek a legmagasabb értékek ... mert fölösleges először a kisebbeket kiosztaniill. ott van az is amit említettem hogy egy bizonyos cella értékétől függően új sort válthatna
pl. ha az érték ~200 -ra csökken (ill. min. db x 5 meglegyen) -
#90999040
törölt tag
válasz
cousin333
#14029
üzenetére
Igen, ismétléses kell, de abból indultam ki, hogy ahhoz, hogy algoritmus szintjén ki tudd szűrni az ismétlődéseket, ahhoz jó eséllyel le kell generálni az ismétlés nélküli eseteket...
De ha felesleges körök nélkül sikerülne is csak az ismétléseseket egyből eltalálni, még az is 1,7322649796561E+48, szóval iszonyatosan sok, és akkor még nem is vettük figyelembe, hogy ez csak a konkrét példára vonatkozik, ami természetesen még negatív irányba is változhat...De a megoldás nem ilyen bonyolult, mert nem kell ennyi esetet végigvenni
Semennyire sem bonyolult, ha írsz olyan algoritmust, ami elsőre eltalálja a legjobb megoldást, mert ekkor 1 kísérlet bőven elég.
Azon az úton még el lehetne indulni, hogy az adott fix hossz ismeretében csak a lehetséges megoldásokat figyelembe venni. Ez az algoritmus viszonylag gyorsan lefut(kb. 1 másodperc sem), de a gondok utána jönnek. Ugyanis ezekkel az adatokkal a lehetséges esetek száma 1048. Ebből 238 olyan, amelyekre még a legrövidebb szál sem férne rá pluszban a 6 méterre. Ha biztosra kellene menni, akkor a következő eseteket kellene vizsgálni:
N K
1048 19
1048 20
1048 21
..... és még ki tudja meddig???mert a hosszokból az következik, hogy elvileg 19 darab 6 méteresnek elégnek kellene lennie(elméletileg). Azért több K-ra, mert egyáltalán nem biztos, hogy a valóságban is elég a 19 szál(mi van, ha pl. csak 23 szál a legkedvezőbb???). Ha az 1048 helyett a 238-al(tehát csak azokkal foglalkozunk, amire több már biztos, hogy nem fér rá), még akkor is elég sok esetnél tartunk...
-
válasz
#90999040
#14027
üzenetére
ennél már akkor egyszerűbb ha egy táblakiosztó progiba beadom a tábla szélességű hosszakat s így úgy működne mintha szálkiosztana ...
de ott is ismételten kézzel kéne bevinni az adatokat ami további hibalehetőséget generál
mert az a kis egyszerű excel amit csináltam legalább képes arra hogy a végösszegeket ellenőrizze hogy biztos minden elemből a megfelelő darabszám szerepel e
a táblakiosztási módszerbe meg az lenne a jobb hogy ott tudok a vágóréssel is kalkulálni
mod: s merre lehetne elindulni amúgy?
-
cousin333
addikt
válasz
#90999040
#14027
üzenetére
Szerintem meg ismétléses permutáció lenne, mert az egyforma hosszú léceket nem lehet megkülönböztetni. Akkor pedig 72! / (12! * 6! * 6! * 12! * 24! * 12!), ami persze még mindig nem kevés.
De a megoldás nem ilyen bonyolult, mert nem kell ennyi esetet végigvenni éppen azért, mert a szálak hossza fix, tehát a lécek nem jöhetnek akármilyen sorrendben.
-
#90999040
törölt tag
válasz
detroitrw
#14023
üzenetére
Megoldani meg lehet, csak kérdés, hogy mennyi idő alatt.
Sima függvényekkel szerintem teljesen kizárt, vba-val lehetséges. De azért gondolj bele:
Úgy látom, hogy 72 darab léc van jelenleg. Ennek a 72 elemnek kell(ene) az ismétlés nélküli permutációja, ami ugye 72! (faktoriális) ez ~~8,50478588567862E+101 eset, azaz kb. 8 a 101-ediken.
Namost ezt ha most elindítod, akkor talán( ) 1 hét múlva végez.Esetleg azt meg lehetne próbálni, hogy bizonyos hulladékszálakot megadni, és ha ez a százalék elég nagy, akkor van esély, hogy előbb talál egy ezen belülit.
Vagy random generálással is lehetne, szerencsés esetben előbb-utóbb beleakad egy alkalmas lehetőségbe....
-
-
buherton
őstag
válasz
Delila_1
#14015
üzenetére
Köszi! Végre ezen a vonalon is elindulhatok
. Csak a probléma, hogy nincs elég időm kidolgozni rendesen .Lehet olyat csinálni, hogy a makróból létrehozott excelhez rendelek saját makrót? Például én azt szeretném ha a makró által létrehozott excelben ha beírok egy számot akkor a másik lap váltson piros háttérre valamilyen esemény hatására. Nekem elég az absztrakt megközelítés is. Fontos, hogy ahhoz az excelhez tartozzon, vagyis önállóan működjön, és makró legyen ne függvény, és nem tudom hogy angolul hogyan keressek rá.
-
-
bozsozso
őstag
Sziasztok,
Szeretnék makróban olyat csinálni, hogy egy adott oszlopban adott szöveget keressen meg és ha megtalálta akkor a ennek a sornak az összes adatát másolja át mondjuk az adatok munkalap 2.sorába majd keresi a következőt ha megvan az meg mehet a következő sorba. Makrórögzítéssel megcsináltam auto szűrő majd másol beilleszt a megfelelő helyre, de nincs ettől jobb, "elegánsabb" megoldás? Valamint esetleg olyat, hogy ha az oszlopban amiben keresek bármi módosítás történik akkor legyen végrehajtva a makró?
Pl.:Érték1 jó 5,00
Érték2 rossz 10,00
Érték3 nagyon rossz 15,00
Érték4 jó 48,00Szeretném ahol jó szerepel az kerüljön át az adatok munkalapra a 2. sortól kezdődően.
Érték1 jó 5,00
Érték4 jó 48,00Előre is köszönöm a segítséget.
-
Oly
őstag
Sziasztok
Adott egy ComboBox, aminek a forrását egy nagy adattáblából akarom szűréssel megoldani.
A Rowsource-ba kellene beraknom egy filtert?
Az űrlapon van egy TextBox, ami alapján a táblában lévő adatokból csak a hozzá tartozót kellene betöltenie.
Gyümölcs - Alma
Gyümölcs - Körte
Autó - Opel
Autó - BMW
Szín - Zöld
Szín - KékHa a textbox értéke gyümölcs, akkor a Combobox-ban csak az Alma és Körte legyen.
A dolgot bonyolítanám azzal, hogy a ComboBox-ban 2 oszlop értékét is megjeleníteném.Segítségetek előre is köszönöm.
-
Sziasztok!
Egy olyan kérdésem lenne hogy miként lehet egy bizonyos cellába iratni a fájl mentési idejét?
Élőlábnak már megcsináltam, de fogalmam sincs hogy kéne konkrét cellába (L5) rakatniez az élőláb tartalma:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Calculate the date and time stamp string
Dim TS As Date
TS = Now
Dim TSS As String
TSS = FormatDateTime(TS, 1) & " "
'Place time stamp into the cell labeled SaveTimestamp
'Range("SaveTimestamp").Value = TSS
'Place time stamp into the header or footer for printing
Dim WS As Worksheet
For Each WS In Worksheets
WS.PageSetup.LeftFooter = " City," & TSS
'WS.PageSetup.LeftFooter = ThisWorkbook.FullName
Next WS
End Submiként kéne átírni hogy az L5-ös cellába legyen a tartalom?
Előre is köszönöm a segítséget
-
Delila_1
veterán
válasz
buherton
#14010
üzenetére
Az A1:A10 tartomány rövidítését beírja a B1:B10 tartományba, és megvizsgálja a COUNTIF (darabteli) függvénnyel, hogy hány db ilyen van a B oszlopban. Ha 1-nél több, akkor a B oszlopba az A megfelelő cellájának az első és harmadik betűjét írja. Lehetne cifrázni, mert előfordulhat, hogy több azonos alakul ki így is. Ahhoz újabb ciklusok kellenek, egy Do-Loop, és egy For-Next. Ha több időm lesz, és szükséges, megírom.
Sub rovidites()
Dim sor%, szo$, betu%
For sor% = 1 To 10
szo$ = Cells(sor%, "A")
If InStr(1, szo$, " ") Then 'ha van benne szóköz
For betu% = 1 To Len(szo$)
If Asc(Mid(szo$, betu%, 1)) > 64 And Asc(Mid(szo$, betu%, 1)) < 91 Then 'nagybetű
Cells(sor%, "B") = Cells(sor%, "B") & Mid(szo$, betu%, 1)
End If
Next
Else
Cells(sor%, "B") = Left(szo$, 2)
End If
If WorksheetFunction.CountIf(Columns(2), Cells(sor%, "B")) > 1 Then _
Cells(sor%, "B") = Left(szo$, 1) & Mid(szo$, 3, 1)
Next
End Sub -
Cheesy
őstag
Sziasztok
A következőt nem sikerül megoldanom:
1. A1-A5 cellákban zsalukő méretek
2. B1-B2 cellákban zsalukő súlyokEgy tetszőleges cellába (pl. másik munkalap D1) kellene egy legördülő menü, mely tartalmazza A1-A5 cellák tartalmát (idáig megy, el is neveztem "méretek"-nek), majd a mellette lévő cellába kiírja a hozzá tartozó súlyt. Tehát, ha A2-t választom legördülőből, akkor B2-t írja ki a másik munkalapon a D2-be.
Remélem érthető valamelyest... segítségeteket előre is köszönöm!
-
buherton
őstag
válasz
Delila_1
#14009
üzenetére
Köszi! Én vagyok a hibás, mert nem írtam le rendesen a feladatot. Az a feladat, hogy adott pl. a Static Planar, akkor abból a nagy betűket olvassa ki, és tegye bele egymásik cellába. Viszont ha nem több szóból áll a kifejezés, akkor olvassa be az első nagy betűt, és a közvetlenül utána közvetkező kisbetűt is. Bonyolódik a dolog, azzal, hogy nem lehet két azonos rövidítés.
Csak példának lett betéve
. A másodiknál különböző műveleteket csináltam, hogy még mire fog leftuni az sheet active szubrutin -
Delila_1
veterán
-
buherton
őstag
válasz
cousin333
#14006
üzenetére
Nagyon köszi a segítséget!
Sub asd()
Sheets(1).Activate
Sheets(2).Activate
Sheets.Add
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Cells.Interior.Color = 15773696
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Sh.Cells.Interior.Color = -16776961
End SubKét formázást használok egy excelen belül, így két utat kellett találni, és meg is van
. Áááh baromi jó ez a VBA.Még egy kérdésem lenne, aztán leállítom magam. Ha mondjuk van egy kifejezés Static Planar, akkor hogyan tudom pl. a két nagy kezdő betűt kiszedni? Illetve pontosabban megfogalmazva, hogyan tudok egy stringen belül egyesével végig menni a karakteren? Ezzel együtt, hogyan tudok összeállítani stringet?
-
cousin333
addikt
válasz
buherton
#14005
üzenetére
"Az már csak hab a tortán, hogy két gépen dolgozok. Egyiken magyar office 2010 van, a másikon angol office 2003."
Részvétem...
"Hogyan lehet olyan function készíteni, hogy ne legyen bemenő változó, és ne térjen vissza semmivel? Egyáltalán lehet ilyen?"
Tudtommal nem lehet. A function azért function, mert értékkel tér vissza. Cellát formázni meg pláne nem lehet vele, még azt sem, amelyikbe beleírod.
Szubrutinnal viszont tudsz formázni, nem kell, hogy bemenete vagy kimenete legyen. Csak a hívását kell megoldanod valahogy. Vagy egy másik függvény triggereli (szubrutin, nem function!), vagy mondjuk egy gombra kötöd.
-
buherton
őstag
válasz
cousin333
#14004
üzenetére
Közben rájöttem, hogy user error volt
. A hiba üzenet szövege ennyit volt: 400 . Az volt a probléma, hogy egy cellában lévő értékből munkalap nevet szerettem volna készíteni. Ez mind addig jó volt, amíg bele nem ütközött egy olyan értékhalmazba, amiben volt kettős pont. Emiatt dobta a hiba üzenetet nekem.Pont ma volt egy másik hasonló eset, amikor egyik excel fájl cellájáról egy másik excel cellájára hivatkoztam (ezt is automatizáltam), és az elérési útban nem lehet aposztróf, ezért ekkor is ilyen 400-as hibát dobott vissza.
Ez a harmadik VBA-m, és az ilyen "apróságok"-ra még nem tudok könnyen rájönni, mert nincs meg a rutin, hogy hol mi miatt állhat meg. Osztályokkal is sokat bajlódok, mert nem mindegy, hogy mikor mit írok.
Az már csak hab a tortán, hogy két gépen dolgozok. Egyiken magyar office 2010 van, a másikon angol office 2003. Fájlformátumot a 2010-ben mindig be kell állítani, az ilyen Sheets("Sheet1")-eket el lehet felejteni, túl nagy cellát sem lehet másolni 2003-ban, stb...
Eddig teljesen hidegen hagyott az excel, most meg teljesen bele zúgtam, hogy bármit megcsinálhatom benne.
Hogyan lehet olyan function készíteni, hogy ne legyen bemenő változó, és ne térjen vissza semmivel? Egyáltalán lehet ilyen? Formázásokat szeretném kitenni függvényekbe. Vagy ilyenkor az objektum referenciája lesz a bemenő változó?
-
Nyilván lehetne még rajta reszelni, de úgy tűnik, működik, méghozzá elég gyorsan. A kód feltételezi, hogy a kérdéses számok az A1:A20000-es tartományban vannak. Akkor is így kell megadni, ha a számok csak a 2. sorban kezdődnek! Ha nem az első sorból indítasz, akkor módosítgatni kell a kódot, mert nálam a tartomány indexe és a sor száma ugyanaz (lásd a For ciklust).
)
![;]](http://cdn.rios.hu/dl/s/v1.gif)
)
Új hozzászólás Aktív témák
- BESZÁMÍTÁS! ASRock B450M R5 Pro 3400G 16GB DDR4 240GB SSD 2TB HDD GTX 1070 8GB RAMPAGE Shiva 450W
- HPE Aruba switch, 48G PoE+, 4SFP+, L3, Smart managed
- Azonnali készpénzes Apple Macbook Air felvásárlás személyesen / csomagküldéssel korrekt áron
- BESZÁMÍTÁS! MSI PRO X670-P R5 7600X 32GB DDR5 1TB SSD RX 6900 XT 16GB ZALMAN Z1 Plus Asus 1000W
- 134 - Lenovo Legion Pro 7 (16IRX8H) - Intel Core i9-13900HX, RTX 4090 - 3 év garancia
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest