-
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
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Házimozi belépő szinten
- TCL LCD és LED TV-k
- Diablo IV
- Kerékpárosok, bringások ide!
- exHWSW - Értünk mindenhez IS
- Építő/felújító topik
- Kínai és egyéb olcsó órák topikja
- Kormányok / autós szimulátorok topikja
- Mibe tegyem a megtakarításaimat?
- További aktív témák...
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- Bomba ár! Lenovo ThinkPad T420 - i5-2G I 8GB I 160GB I DVDRW I 14" HD+ I Cam I Garancia!
- Honor X6 /4/64GB / Kártyafüggetlen / 12Hó Garancia
- Fujitsu LifeBook 7U14A2 netbook / 12 hónap jótállás
- ÁRGARANCIA!Épített KomPhone i5 14600KF 16/32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest



Fferi50