-
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
-
karlkani
aktív tag
válasz
DasBoot
#51908
üzenetére
Meg kellene osztani a követelményeket, akkor tudnának segíteni a fórumtársak, akik értenek a makróhoz. Sajnos ez ügyben nem tudok segíteni (nem igazán értek hozzá), általában itt kérek segítséget, vagy privátban a topikgazdától, ha valamit meg szeretnék oldani makróval.
-
Delila_1
veterán
válasz
DasBoot
#51899
üzenetére
Kiegészítettem bela85 linkelt makróját úgy, hogy a számokat emelkedő sorrendbe rakja.
Sub LottoSzamok()Dim Rng As Range, WorkRng As Range, xNumbers(49) As Integer, xTitleId As StringDim xIndex As Integer, xNum As Integer, Cim As Range, Lapnev As StringLapnev = Selection.Worksheet.NameOn Error Resume NextxTitleId = "Véletlen számok"Set WorkRng = Application.SelectionSet WorkRng = Application.InputBox("Melyik cellában kezdődjön?", xTitleId, WorkRng.Address, Type:=8)Set WorkRng = WorkRng.Range("A1")For xIndex = 1 To 49xNumbers(xIndex) = xIndexNextFor xIndex = 1 To 6xNum = 1 + Application.Round(Rnd * (49 - xIndex), 0)WorkRng.Offset(0, xIndex - 1).Value = xNumbers(xNum)xNumbers(xNum) = xNumbers(50 - xIndex)NextSet Cim = Range(WorkRng.Range("A1"), WorkRng.Offset(0, 5))Range(Cim.Address).SelectActiveWorkbook.Worksheets(Lapnev).Sort.SortFields.ClearActiveWorkbook.Worksheets(Lapnev).Sort.SortFields.Add2 Key:=Range(Selection.Address), _SortOn:=xlSortOnValues, Order:=xlAscendingWith ActiveWorkbook.Worksheets(Lapnev).Sort.SetRange Range(Selection.Address).Header = xlGuess.MatchCase = False.Orientation = xlLeftToRight.SortMethod = xlPinYin.ApplyEnd WithEnd Sub -
Delila_1
veterán
válasz
DasBoot
#25262
üzenetére
Nézd meg ezt:
Function LongDec2Bin(ByVal nIn As Long, Optional nBits As Long = 0&) As Variant
'J.E. McGimpsey műve, és Harlan Grove módosítása
Dim nReqBits As Long
Dim sOut As String
Dim sBit As String
Dim bNeg As Boolean
Dim i As Long
If nIn < 0& Then
bNeg = True
nIn = -(nIn + 1&)
End If
If nIn = 0& Then
nReqBits = 1&
Else
nReqBits = Int(Log(nIn) / Log(2&)) + 1& - bNeg
End If
If nBits <= 0& Then nBits = nReqBits
If nBits >= nReqBits Then
If bNeg Then
sOut = String(nBits, "1")
sBit = "0"
Else
sOut = String(nBits, "0")
sBit = "1"
End If
For i = nBits To (nBits - nReqBits + 1&) Step -1
If (nIn - 2& * (nIn \ 2&)) > 0 _
Then Mid(sOut, i, 1&) = sBit
nIn = nIn \ 2&
Next i
LongDec2Bin = sOut
Else
LongDec2Bin = CVErr(xlErrNum)
End If
End Function -
Fferi50
Topikgazda
válasz
DasBoot
#25265
üzenetére
Szia!
Dec2Bin csak 10 számjegyig jó. E fölött be kell vetned az általános iskolában tanult ötletet - maradékos osztással megkeresed a számjegyeket és egymás mellé írod egy szövegben.
Azaz kiindulsz az adott számból: A1 cella. Mellé írod (B1 cella) a = maradék(A1;2) képletet. Alá pedig az int(A1/2) képletet, ezt végighúzod az oszlopokon addig, hogy az osztás eredménye 1 legyen.
Ezután a B oszlop eredményét visszafelé haladva összefűzöd.Persze makróval ez gyorsabb.
Üdv.
-
Apollo17hu
őstag
válasz
DasBoot
#22310
üzenetére
De válaszolok, nehogy legközelebb is miattam puffogj. A "Magyarul?" nálam meg sem közelíti a normális kategóriát.
Légy szíves? Vagy: megtennéd, hogy magyarul is leírod? Számos lehetőség van, én úgy válaszoltam, ahogy a kérdésed feltetted.Azon meg konkrétan beszarok, hogy még arra is vetted a fáradságot - ahelyett, hogy ideiglenesen angolra állítottad volna az Excel-ed -, hogy privát üzenetben személyeskedj.
-
Delila_1
veterán
válasz
DasBoot
#21919
üzenetére
Talán így érthetőbb:
Ha jobb(g10;1)<>„k” ÉS jobb(g10,1)<>„M” (nincs prefixum a G10 végén)
akkor a cella értéke legyen g10*2*PI()
Ellenkező esetben
ha jobb(g10;1)=”k”
akkor a cella értéke legyen bal(g10;hossz(g10)-1)*2*PI()*1000
ellenkező esetben (itt már csak M lehet az utolsó karakter)
a cella értéke legyen bal(g10;hossz(g10)-1)*2*PI()*1000000
feltétel vége
Feltétel végeLehet még egy halom hiba, például nincs levédve az ellen, ha valaki a szám után egy J karaktert visz be, vagy akár egy szóközt.
-
Új hozzászólás Aktív témák
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Nem indul és mi a baja a gépemnek topik
- OTP Bank topic
- Sorozatok
- Óra topik
- sziku69: Fűzzük össze a szavakat :)
- Kormányok / autós szimulátorok topikja
- Motorola Moto Watch – még nem teljes a kör
- Luck Dragon: Asszociációs játék. :)
- Jogász topik
- További aktív témák...
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Új Asus Zenbook S14 WQXGA OLED 120Hz Ultra7 258V 32GB 1TB SSD Intel Arc 140V 16GB Win11 Garancia
- Beszámítás! Asus VZ239HE-W White 75Hz FHD IPS 5ms monitor garanciával hibátlan működéssel
- HP Pavilion Plus 14-ey0155ng Ryzen 5-7540 / 16GB / 512GB FHD+ Garancia
- iPhone Xr 64GB 100% ÚJ EREDETI AKKUMULÁTOR Gyűjtői darab (3hónap Garancia)
- Új Lenovo Thinkbook 14 G7 WUXGA IPS Ultra7 155H 16mag 32GB 1TB SSD Intel Arc Win11 Pro Garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest



Fferi50