- iPhone topik
- Xiaomi 14T Pro - teljes a család?
- Motorola Edge 40 - jó bőr
- Egy szenzor, két zoomkamera: újraírta a Huawei a mobilfotózás történetét
- Google Pixel 9 Pro XL - hét szűk esztendő
- Google Pixel topik
- Megérkezett a Google Pixel 7 és 7 Pro
- Honor Magic7 Pro - kifinomult, költséges képalkotás
- Poco M3 - felújított állomás
- Térerő gondok, tapasztalatok
-
Mobilarena
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
föccer
nagyúr
válasz
detroitrw
#53244
üzenetére
A képletedbe mindenképpen a "C T" nevű fülön keresed az adatokat.
Mintha a C T fülön kellene kikeresni az B1 cellához tartozó dátum hetéhez tartozó oszlopból az adatokat. Viszont eddig a pontig (az én logikám szerint) még csak azt találtuk meg, hogy melyik oszlopban kell a keresést végre hajtani. A te képletedben az index fixen az 1 sort adja vissza (ezért javasoltam a vkerest- helyette).
Akkor a C T fülön, a B1-ben megadott dátum hetéhez tartozó oszlopban kell kikeresni azt a legnagyobb értéket, amely 20-nál kisebb?
Itt egy olyan kérdésem van, hogy az adott oszlopban csak az első 20 vagy nagyobb értékig keresünk, vagy a teljes oszlopban meg kell vizsgálni a 20nál kisebb értékeket és abból kiválasztani a legnagyobbat?
-
Mutt
senior tag
válasz
detroitrw
#53229
üzenetére
Szia,
Ha nem néztem el vmit akkor ez műkődhet:
=INDEX('C T'!$A$1:$CQ$775;1;HOL.VAN(20;INDEX('C T'!$A$1:$CQ$775;HOL.VAN($B$1;'C T'!$A$1:$A$775;0);0);1))Ha MS365-ön vagy, akkor ez esetleg:
=INDEX('C T'!$A$1:$CQ$775;1;HOL.VAN(20;SZŰRŐ('C T'!$A$1:$CQ$775;'C T'!$A$1:$A$775=$B$1);1))üdv
-
föccer
nagyúr
válasz
detroitrw
#53229
üzenetére
INDEX('C T'!$A$1:$CQ$775;1;HOL.VAN(20;INDIREKT("'C T'!A414:CQ"&HOL.VAN($B$1;'C T'!A1:A775;0);1))
használd a hivatkozás előállítására az INDIREKT függvényt, amivel ki tudod keresni a dinamikus tartományodnak a végét (ha jól látom, akkor addig kell keresni, amíg a 'C T' munkafüzet első sorában nem szerepel a 20-as szám). Miáltal az első index-ben fixen az első sor van megadva, lehet egyszerűbb lenne a VKERES() függvényt használni.
-
#52929
Fire/SOUL/CD
félisten
detroitrw
#52927
-
#52926
Fire/SOUL/CD
félisten
detroitrw
#52923
válasz
detroitrw
#52923
üzenetére
function onEdit(e){
var range = e.range;
// 8. sorban található cellákat vizsgálja csak, módosítsd, amire Neked szükséges
if (range.getRow() == 8) {
SpreadsheetApp.getActiveSheet().getRange(range.getRow()+1,range.getColumn()).setValue('Utolsó módosítás: ' + Utilities.formatDate(new Date(), "Europe/Budapest", "yy-mm-dd-HH:mm:ss"));
// Az alábbi inaktív sor a 8. sorban modosított cellába kommentként (megjegyzésként) teszi bele a módosítás dátumát
// range.setNote('Utolsó módosítás: ' + Utilities.formatDate(new Date(), "Europe/Budapest", "yy-mm-dd-HH:mm:ss"));
}
} -
Fferi50
Topikgazda
válasz
detroitrw
#52349
üzenetére
Szia!
"a gépen lévő excel és a google drive -os excel más eredményre jut ezzel a paranccsal:=HOL.VAN(H1;'Ablak'!1:1)"Bizonyára elkerülte a figyelmedet, hogy a HOL.VAN függvénynek van egy harmadik paramétere is, ami a keresés módját határozza meg. Ha elhagyod, akkor az alapértelmezett értéket veszi alapul. Az eltérés amiatt lehet, hogy más az alapértelmezett értéke az Excelben és más a Google drive táblázatban.
Megjegyzés:
Kérlek, ne írd azt, hogy google drive-os Excel, mert ilyen nincs! A google dríve-on google táblázat van, ami formailag és sok-sok függvény esetében hasonlít az MS Excelhez, de abszolúte nem ugyanúgy viselkedik.
Üdv. -
föccer
nagyúr
válasz
detroitrw
#52347
üzenetére
a SOR() illetve az OSZLOP() függvény vissza adja a függvényt futtató cella sor, illetve oszlop számát. A hol.van által adott értékhez csak simán add hozzá.
ps:
A sor és az oszlop id működik úgy, hogy paraméterként egy hivatkozás van, akkor a hivatkozott cellának a sorát/oszlopát adja vissza.
-
Fferi50
Topikgazda
válasz
detroitrw
#52325
üzenetére
Szia!
drive-os excel alatt mit értesz?
Ha google sheet-et, akkor abban sajnos nincs ilyen eszköz, de az fx szerkesztősorra kattintva megmutatja, mely cellák vesznek részt a képletben.
Ha megosztott excelre gondolsz, akkor az fx gomb ugyanúgy viselkedik, mint a normál excelben.
Üdv. -
-
Fferi50
Topikgazda
válasz
detroitrw
#52226
üzenetére
Szia!
"ha beirok egy szamot nem tortenik semmi"
Miért is történne? ez nem eseménykezelő, csak egy sima makró.
Ha beírtad a számot, el kell indítani a makrót a Bővítmények - makrók - myFunction-ra kattintva. Illetve a makrók kezelésében rendelhetsz hozzá billentyűkombinációt.
(Írtam is ezt korábban...)
Üdv. -
Fferi50
Topikgazda
válasz
detroitrw
#52221
üzenetére
Szia!
Az alábbi kódot másold be a Google sheetbe:function myFunction() {var spreadsheet = SpreadsheetApp.getActive();Var xx = spreadsheet.getNumSheets()var uzenet=' 'Var yy = 1for (var yy=0; yy< xx ;yy++) {if (spreadsheet.getSheets()[yy].getRange("B2").getValue() > 0){if (uzenet> " "){uzenet=uzenet + ', ' +spreadsheet.getSheets()[yy].getName()} else {uzenet=spreadsheet.getSheets()[yy].getName()}}}if (uzenet > ' '){uzenet= uzenet + ' munkalapon van adat' }else { uzenet='Nem találtam adatot'}// console.log(uzenet)Var htmlApp = HtmlService.createHtmlOutput (uzenet).setTitle('Google munkalapok').setWidth (250).setHeight(300);SpreadsheetApp.getActiveSpreadsheet().show(htmlApp);}
A bővítmények menücsoportból válaszd az AppScriptet:
Ezután a megjelenő megjelenő pár sort írd felül vagy töröld ki, majd másold be a fentieket. Így kell kinéznie:
Ezután mented és visszatérsz a Google Sheethez.
A bővítmények Makrók menüpont alján meg fogod találni a myFunction makrót - rákattintva elindul. A Makrók kezelése menüpontban rendelhetsz hozzá billentyű kombinációt.
Ha nem találnád a makrók között, akkor a Makró importálása menüponttal tudod a kódból beimportálni.
Remélem, sikerrel jársz és erre gondoltál.
Üdv. -
Fferi50
Topikgazda
válasz
detroitrw
#47179
üzenetére
Szia!
Ezek az adatok szövegek - ilyen formátumban adta át a forrás. A szöveg nem reagál a cellaformátum változásra, hiszen nem tud átalakulni magától.
A dátummá alakítás egyik módja az, ahogyan te csináltad. A megjelenési formája azért nem változott, mert az alap dátum formátumod valószínűleg ilyen pontokkal elválasztott.
Akkor is dátummá változik, ha a pontot pontra cseréled! - azaz látszólag semmi nem történik.
További - általános szöveg számmá alakítási lehetőség: egy cellába beírsz egy db egyest (1), ezt kijelölöd, másolod. Majd kijelölöd az átalakítandó cellákat - irányított beillesztés - szorzás.
Ennek eredményeként számmá fog alakulni a szöveg - esetünkben az általad "hiányolt, értelmetlen" számsorrá. Ezután a cellaformátumot már megváltoztathatod dátumra.
Az "értelmetlen" számok magyarázata:
Az Excel a dátumot (és az időt) számként ábrázolja és értelmezi, mégpedig az 1900. január 1 az alap, azt tekinti 1 értéknek. A dátumot az ehhez képest eltelt napok száma jelenti - általános és szám cella formátum esetén ezek a számok jelennek meg, pl ma =4405. A napokat az egész számok jelentik, az időt pedig a nap törtrésze, azaz a dátumot/időt jelentő számok törtrésze. Mivel egy nap 24 órából áll, egy óra az 1/24 tört alakban, 6 óra 1/4 (0,25), 12 óra 1/2 (0,5) .Így ma 12 óra az Excelben 4405,5 lesz.
Üdv. -
Delila_1
veterán
válasz
detroitrw
#22818
üzenetére
Bemásolod a makrót a füzetedbe, és egy gombhoz rendeled.
Sub Vagolapra()
Dim valaszt As Integer, FN As String
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
valaszt = Application.FileDialog(msoFileDialogOpen).Show
If valaszt <> 0 Then
FN = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
Workbooks.Open Filename:=FN
Range("A1:D2000").Copy
Else
MsgBox "Nem választottál fájlt!", vbOKOnly + vbInformation
Exit Sub
End If
End Sub -
csferke
senior tag
válasz
detroitrw
#20833
üzenetére
ez nem jó?
=AVERAGEIF(B:B;E3;C:C)
igen, ez jó lett, köszi
Most azonban tovább bonyolítanám a kérdésem.
A C oszlop adataiból van egy diagramom, havi lebontásban a következő tartományok.
=$C$2:$C$8
=$C$9:$C$15
=$C$16:$C$22Hogyan tudnám automatikusan bővíteni a diagramot amikor új évet adok hozzá? =$C$23:$C$29 ??
-
válasz
detroitrw
#20812
üzenetére
koszi a faradozast, de sajnos ez sem lesz jo, a felso sorban tobbszor is elofordulnak a gyumik.
olyan valami kell, ami megszamolja hany kulonbozo gyumi van, es ezek ala listazza egyenkent az ertekeket. a tobbi szukseges muvelet is bonyolitja a dolgot, de azokat meg tudom csinalni
Jah, axt nem irtam, hogy valami vba kod kellene.
-
fuli07
csendes tag
válasz
detroitrw
#20636
üzenetére
Ha van egy sport eredmény mondjuk 2-1!
Megvizsgálja hogy a 2 nagyobb mint 1 akkor a hazai csapat cellaértéke 3 ha fordítva akkor nulla ha egyenlő akkor 1. -->ezt ugyahogy megoldottam 4 HA függvénnyel ha tudsz egyszerűbbet, váromViszont ha nincs eredmény beírva akkor NE vizsgálja, mert különben mindig beír 1-es értéket!
Köszönöm
-
#20175
Térközjelző
csendes tag
detroitrw
#20123
Térközjelző
csendes tag
válasz
detroitrw
#20123
üzenetére
Köszönöm szépen a gyors segítséget!
Elnézést, de most jutottam gép közelbe.
Az elrendezés, és egyebek tökélete lett.
Mivel nem fogalmaztam pontosan ezért akad a dologgal egy kis probléma:
A kategóriák nem pontosan az utazás hosszát adják, hanem pl az adott távom érvényes menetjegyek kategóriáját, valahogy így:
84km >> 90-es kategória, mert 80 fölött még 4 km le kell utazni
36km >> 40-es kategória, mert 35 fölött még 1 km le kell utazni
92km >> 100-as kategória, mert 90 fölött még 2 km le kell utazniEbből is látszik, hogy a köznapi életben elég felületesen fogalmazunk.
Köszönöm szépen.
-
ADAM1337
nagyúr
válasz
detroitrw
#18831
üzenetére
Köszönöm meg vallom ennyire nem értek hozzá.
Valamiért nem engedi lehúzni csak soron belűl érvényes, átírtam a változókat is (cella számokat egyel lejebb és arra hibát dob.)
Rájöttem a webes felület a számok után is szóközt hagyott azt javítom, köszönöm a segítséget !
-
kőbaltazár
tag
válasz
detroitrw
#18803
üzenetére
Köszi, nagyon jó lett.
Ha én ebbe a Csótánycspdák.xls táblázatba szépen berakok 13 munkalapot pl: január; február... plusz egy olyat a végére, ami ősszegzi az egész évben felhasznált anyagot, ezt meg tudom csinálni.
Olyan létezik-e, hogy például egy Összegzés.xls tábla év végén a Csótánycspdák.xls és a hasonlóképpen felépített Rágcsálóirtó szerelvények.xls táblázatban is összeadja az egész évben felhasznált anyagokat? -
-
kőbaltazár
tag
válasz
detroitrw
#18780
üzenetére
Kedves detroitrw!
Köszi a gyors reagálást, sajnos csak most értem gépközelbe.
Az igazság az, hogy amit leírtál, tökéletesen működik, de én sajna nem írtam le egyértelműen, hogy mit szeretnék.
B22 : B37 mind lenyíló ablak, és I21 : I25 -ből veszi az adatokat. Ezt végig kell játszanom, a szerelvények ellenőrzése során.
A C22 : C37 tartományba, ha az érintetlen, és az eltűnt cella után berakná magától az 5 darab minusz jelet jó lenne (bár, hogy én hogy raktam be már nem tudom, mert mindíg valami képletet hiányolt). Természetesen a fogyás, a jelentős fogyás és a megrongálódott cella utánit nem lehet az excelre bízni, mert ez mindíg az adott helyzettől függ, és ez megint rám marad a helyszinen.
A D22 : D37 cellába a megtett intézkedésnek kellene kerülnie, az I36 : I38 tartományból a következők szerint.
Érintetlen, fogyás és jelentős fogyás esetén T, F.
Megrongálódott esetén Ú K új kihelyezése
Eltűnt esetén pedig SZ P szerelvény pótlása.
Ez az űrlap egy cégnél a rágcsálóirtás nyomonkövetését hivatott ellenőrizni, amivel az év végén majd trendanalízist tudunk készíteni. Szerintem a kutya sem fogja megnézni, de a higiénikus hölgynek kiadták, hogy meg kell csinálni, és neki is kb annyi fogalma van erről mint nekem. Mikor rágcsálóirtó lettem komolyan fogalmam sem volt arról, hog a patkányokat majd vonalkóddal kell ellátni, de már ettől sem állunk messze.Előre is köszönöm a segítséget Neked, és a Többieknek is nagyon sokat tanultam eddig is belőle.
-
#17031
Fire/SOUL/CD
félisten
detroitrw
#17025
-
#17014
Fire/SOUL/CD
félisten
detroitrw
#17012
-
#17006
Fire/SOUL/CD
félisten
detroitrw
#17005
válasz
detroitrw
#17005
üzenetére
"arra megkérhetnélek hogy egy ilyen kis szövegdobozos megjelenítős félét megtudnál osztani ami Nálad működik?"
Pont ezt tettem itt.
(Létrehozol egy új üres munkafüzetet, beszúrsz 2 darab ActiveX Command Button-t (egyik lesz a CommandButton1, másik a CommandButton2), rájuk klikkelsz duplán és az imént linkelt hsz szerint módosítod a makrót.Ennél egyszerűbb megoldás nincs és annak mennie kell.
-
#16982
Fire/SOUL/CD
félisten
detroitrw
#16976
válasz
detroitrw
#16976
üzenetére
Eltünt a netem, nem tudtam szerkeszteni...
Szóval ha az előző módszer megy kifogástalanul, akkor ennyit kell módosítani (példában Munka1 lapon van a command1 és a munka2-n a command2)Munka1 - itt fontos, hogy hivatkozni kell a munka2-re
Private Sub CommandButton1_Click()
Munka2.CommandButton2_Click
End SubMunka2 - itt az a fontos, hogy Public a deklaráció (enélkül munka1-en nem "látja" a command1)
Public Sub CommandButton2_Click()
MsgBox ("CommandButton2_Click")
End SubRitkán alkalmazzák az ilyen megközelítést, pont azért, mert körülményes és könnyen be lehet nézni, helyette Module-ban globálisan célszerű az eljárásokat megírni.
-
#16981
Fire/SOUL/CD
félisten
detroitrw
#16976
-
Excelbarat
tag
válasz
detroitrw
#16944
üzenetére
Hi!
Csak simán ahhoz is hozzárendeled ugyan azt a makrót. (ha netán ezt szeretted volna)
Ha a parancsgomb Űrlapvezérlő elem akkor jobb klikk rá és makró hozzárendelése, Ha ActiveX vezérlő akkor tervező mód bekapcsol és kétszer ráklikkelsz utána beírod a sub és end sub közé, hogy Call makronév. Remélem segített. -
w.miki
veterán
válasz
detroitrw
#16915
üzenetére
Hali!
Excel(2003)ben hogyan lehet megcsinálni, hogy egy cellában a sor végéig pontok legyenek egy oszlopban?
Egy szótár.xls-ról van szó, most így néz ki:
A----------------------B-----------------------------C--------------D
accompaniment kísérő / kiegészítő braise dinsztel hústilyenre szeretném:
A----------------------B-----------------------------C--------------D
accompaniment..kísérő / kiegészítő braise.......dinsztel húst -
Mutt
senior tag
válasz
detroitrw
#16910
üzenetére
Hello,
...ez a makró A1-A2000 -ig végigfusson?
Az elején és a végén kell egy kicsit módosítani:
Dim blnHit As Boolean 'logikai jelző ha már létezik a vizsgált szám
Dim cell As Range
For Each cell In Range("A1:A2000")
arraySplit = Split(cell, strDelimiter)
...<itt marad az eredeti> ...
For i = 1 To UBound(arrayResult, 2)
Cells(cell.Row, cell.Column + i) = arrayResult(1, i) & " db - " & arrayResult(2, i)
Next i
Application.ScreenUpdating = True
End If
Next
End Sub -
Mutt
senior tag
válasz
detroitrw
#16893
üzenetére
Hello,
adott:
A1=1603+1603+640+640+640+388+388 -> pl. B1=2db - 1603Gondolom a számok is változnak (nem mindig csak 1603, 640 és 388 ismétlődik), ezért csak függvényekkel megoldani körülményes, javaslatom a lenti makró (mindig csak a kijelölt cellát vizsgálja):
Sub Szetszed()
Dim arraySplit
Const strDelimiter As String * 1 = "+" 'tagolás jele
Dim arrayResult() 'itt lesznek a darabszámok és a számok/karakterek
Dim c As Long, i As Long
Dim blnHit As Boolean 'logikai jelző ha már létezik a vizsgált szám
arraySplit = Split(ActiveCell.Value, strDelimiter)
If IsArray(arraySplit) And UBound(arraySplit) > 0 Then
ReDim arrayResult(1 To 2, 1) 'találat létrehozása
arrayResult(1, 1) = 1 '1 db
arrayResult(2, 1) = arraySplit(0) 'első érték megjegyzése
'további számokon végigfut
For c = 1 To UBound(arraySplit)
blnHit = False
i = 1
Do
'ha már van ilyen szám, akkor eggyel növeljük a számlálót
If arraySplit(c) = arrayResult(2, i) Then
arrayResult(1, i) = arrayResult(1, i) + 1
blnHit = True
End If
i = i + 1
Loop Until blnHit Or i > UBound(arrayResult, 2)
'ha még nincs ilyen akkor megjegyezzük a számot
If Not blnHit Then
ReDim Preserve arrayResult(1 To 2, UBound(arrayResult, 2) + 1)
arrayResult(1, UBound(arrayResult, 2)) = 1
arrayResult(2, UBound(arrayResult, 2)) = arraySplit(c)
End If
Next c
Application.ScreenUpdating = False
For i = 1 To UBound(arrayResult, 2)
Cells(ActiveCell.Row, ActiveCell.Column + i) = arrayResult(1, i) & " db - " & arrayResult(2, i)
Next i
Application.ScreenUpdating = True
End If
End Subüdv.
-
Delila_1
veterán
válasz
detroitrw
#16898
üzenetére
Szövegből oszlopok, határoló jel a + jel. Ez a példád szerint az A1-be írt adatot szétszedi az A1:G1 tartományba.
Könnyítésként soronként egy függvény megszámlálja, hogy hány féle adat van a sorodban.
=SZORZATÖSSZEG((A1:G1<>"")/DARABTELI(A1:G1;A1:G1))Utána már a darabteli függvénnyel megszámolhatod az egyes adatokat soronként.
J1 -be =DARABTELI($A$1:$G$1;1603)
K1-be =DARABTELI($A$1:$G$1;640)
L1-be =DARABTELI($A$1:$G$1;388) -
#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... -
#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.
-
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.
-
#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....
-
93 cellájára így hivatkozol:
Ezután a megjelenő megjelenő pár sort írd felül vagy töröld ki, majd másold be a fentieket. Így kell kinéznie:
Ezután mented és visszatérsz a Google Sheethez.
) 1 hét múlva végez.
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Új, bontatlan World of Warcraft gyűjtői kiadások
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Csere-Beszámítás! AMD Számítógép PC Játékra! R5 5500 / RX 5700XT / 32GB DDR4 / 256SSD+1TB HDD
- LG 27GR95UM - 27" MiniLED - UHD 4K - 160Hz 1ms - NVIDIA G-Sync - FreeSync Premium PRO - HDR 1000
- Epson Expression 12000 XL Nagyformátumú A3 szkenner
- Thinkpad T480s 24GB RAM 1TB SSD (erős, könnyű, vékony gép) Windows 11
- Beszámítás! Apple iPad Pro 13 2024 M4 512GB Cellular tablet garanciával hibátlan működéssel
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Liszt Ferenc Zeneművészeti Egyetem
Város: Budapest