- Google Pixel topik
- Android alkalmazások - szoftver kibeszélő topik
- iPhone topik
- Yettel topik
- Samsung Galaxy A55 - új év, régi stratégia
- Mobil flották
- Honor 200 - kétszázért pont jó lenne
- Huawei Watch GT 5 Pro - egészség + stílus
- Samsung Galaxy S25 - végre van kicsi!
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
-
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
-
#47534
Fire/SOUL/CD
félisten
Zomb€€
#47532
válasz
Zomb€€
#47532
üzenetére
Gondolom ebben a jó időben nem a gép elutt ülsz, hanem kint vagy/vagytok a szabadban (amúgy jól teszed)
Elolvastam a NodeJS doksit, megnéztem mi is ez a crypto.createHmac függvény ill. a "paramétereit" is megsasoltam, erre jutottam, remélem megfelel.1. Mindenképpen telepíteni kell a .NET Keretrendszer 3.5 változatát
2. VBA Editorban (ALT+F11) Tools/References és a listában keresd meg és jelöld be a Microsoft XML, v6.0 és okézd le. [Microsoft XML, v6.0]
3. Én most egy parancsgombot (CommandButton1) alkalmaztam és ennek a kattintási eseményéhez rendeltem a kód lefutását
4. Munka1-be másolandó kód
Private Sub CommandButton1_Click()
Debug.Print HASHING_THE_STRINGG
Debug.Print QUERY_STRING
Debug.Print AND_RETURN
Debug.Print Signature(QUERY_STRING, APISECRET)
Debug.Print vbNewLine
Debug.Print HASHING_THE_STRINGG
Debug.Print ANOTHER_QUERY
Debug.Print AND_RETURN
Debug.Print Signature(ANOTHER_QUERY, APISECRET)
End Sub5. Module1-be másolandó kód
'Fire/SOUL/CD - 2021
Option Explicit
Public Const QUERY_STRING As String = "timestamp=1578963600000"
Public Const ANOTHER_QUERY As String = "symbol=LTCBTC&side=BUY&type=LIMIT&timeInForce=GTC&quantity=1&price=0.1&recvWindow=5000×tamp=1499827319559"
Public Const APISECRET As String = "NhqPtmdSJYdKjVHjA7PZj4Mge3R5YNiP1e3UZjInClVN65XAbvqqM6A7H5fATj0j"
Public Const HASHING_THE_STRINGG As String = "hashing the string: "
Public Const AND_RETURN As String = "and return: "
Public Function Signature(ByVal sTextToBeCoded As String, ByVal sKey As String)
Dim EncodingType As Object
Dim Encoder As Object
Dim TextToBeCoded() As Byte
Dim Key() As Byte
Dim ByteArray() As Byte
Set EncodingType = CreateObject("System.Text.UTF8Encoding")
Set Encoder = CreateObject("System.Security.Cryptography.HMACSHA256")
TextToBeCoded = EncodingType.Getbytes_4(sTextToBeCoded)
Key = EncodingType.Getbytes_4(sKey)
Encoder.Key = Key
ByteArray = Encoder.ComputeHash_2((TextToBeCoded))
Signature = EncodeBase64(ByteArray)
Set EncodingType = Nothing
Set Encoder = Nothing
End Function
Private Function EncodeBase64(ByRef DataArray() As Byte) As String
Dim XMLObject As MSXML2.DOMDocument60
Dim NODEObject As MSXML2.IXMLDOMElement
Set XMLObject = New MSXML2.DOMDocument60
Set NODEObject = XMLObject.createElement("b64")
NODEObject.DataType = "bin.hex"
NODEObject.nodeTypedValue = DataArray
EncodeBase64 = NODEObject.Text
Set NODEObject = Nothing
Set XMLObject = Nothing
End FunctionMindez és a futtatás követő eredmény képen: [kép]
(A kimenetet (Debug.Print) megjelenítő ablak (Immediate) a CTRL+G bill. kombóval jeleníthető meg)6. Természetesen Excel függvényként is használható a kód.
Remélem ugyanazt az eredményt adja, mint a Node script...
![;]](//cdn.rios.hu/dl/s/v1.gif)
-
#47533
Fire/SOUL/CD
félisten
Zomb€€
#47532
válasz
Zomb€€
#47532
üzenetére
Megtennéd, hogy a kimenetről (lefuttatod a scriptet) dobsz egy képet, mert úgy nem kellene a VBA kódban a titkosítási függvények számos paraméterével egyenként próbálkozni.
Node doksit néztem, vélhetően elsőre is menne, de jobb ha a node script meg a vba kód is ugyanazt a kimenetet eredményezi... -
-
perfag
aktív tag
válasz
Zomb€€
#12032
üzenetére
Igazad van, rossz volt a válaszom. Lehet, de nem úgy.
Google: vba writing data to closed workbookAz egyik lehetőség használj ADO-t. Ez a norvég fickó a kedvencem, mert trondheimi (Rosenborg), bár a kommentek szerint nem műxik a kód. Microsoft terméktámogatás, egy ipse, aki ezt tanítja is, ők sem rosszak.
Miért nem jó neked egy ScreenUpdating=False paranccsal elrejteni a fájl megnyitását? Amit nem látok az nincs is
-
-
-
-
Delila_1
veterán
válasz
Zomb€€
#10458
üzenetére
Nem lenne szabad elszállnia. Be van kapcsolva az Excelben az Analysis ToolPak - VBA?
Próbáld így:set terület=range("a1:c1000")
workbooks("ebből.xls").sheets("erről_a_lapról").terület.copy
workbooks("ebbe.xls").sheets("erre_a_lapra").select
usor=range("a1").end(xldown).row+1
range("a" & usor).select
selection.paste -
-
Delila_1
veterán
válasz
Zomb€€
#10180
üzenetére
Kértem, hogy tegyél be képet. Mivel nem tettél, a saját elképzelésem szerint írtam meg a makrót, majd átalakítod kedved (és az adataid) szerint.
Az egyik lap neve Oktatás, ahol az A oszlop tartalmazza a szak kódját, a B oszlop a szakra jelentkező nevét.
A másik lap Jelentkezők névre hallgat, ahol az A oszlopban van a név, a B:F oszlopokban a hozzájuk tartozó többi adat.
A harmadik lap az Összesítés, itt az A oszlopban lesz a kód, B-ben a jelentkező neve, a C:G tartományban a jelentkező többi adata.
Szerencsére azt tudom, hogy a 2007-es verziót használod. Nem mindegy, mert egészen más a rendezés a különböző verziókban.
Sub Adategyesítés()
Dim sorA%, usorA%, sorV%, usorV%, sorO%
Dim kód$, név$, adatSor%
Dim WSJ As Object, WSO As Object
Sheets("Oktatás").Select
usorA% = Range("A60000").End(xlUp).Row
'"A" oszlop rendezése
usorA% = Range("A60000").End(xlUp).Row
ActiveWorkbook.Worksheets("Oktatás").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Oktatás").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Oktatás").Sort
.SetRange Range("A2:B" & usorA%)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Egyedi rekordok szűrése a V oszlopba
Range("A1:A" & usorA%).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"V1"), Unique:=True
Set WSJ = Sheets("Jelentkezők")
Set WSO = Sheets("Összesítés")
usorV% = Range("V60000").End(xlUp).Row
sorO% = 2
For sorV% = 2 To usorV%
kód$ = Cells(sorV%, 22)
For sorA% = 2 To usorA%
If Cells(sorA%, 1) = kód$ Then
név$ = Cells(sorA%, 2)
WSO.Cells(sorO%, 1) = kód$
adatSor% = WSJ.Range("A:A").Find(név$).Row
WSO.Cells(sorO%, 2) = WSJ.Cells(adatSor%, 1)
WSO.Cells(sorO%, 3) = WSJ.Cells(adatSor%, 2)
WSO.Cells(sorO%, 4) = WSJ.Cells(adatSor%, 3)
WSO.Cells(sorO%, 5) = WSJ.Cells(adatSor%, 4)
WSO.Cells(sorO%, 6) = WSJ.Cells(adatSor%, 5)
WSO.Cells(sorO%, 7) = WSJ.Cells(adatSor%, 6)
sorO% = sorO% + 1
End If
Next
Next sorV%
End Sub -
Cuci3
tag
válasz
Zomb€€
#10180
üzenetére
Ha jól értem: a 2. tábla a nagy (oktatás), az 1. tábla a kisebb (jelentkezők). Én is fkeressel oldanám meg, persze ügyelve, hogy a kulcsok ugyanolyan formátumban legyenek. És az eljársát kicsit gyorsítja, ha a 2. táblához hozzákapcsolandó 15 oszlopra nem egyszerre futtatod le az fkerest, hanem 1-2 oszloponként, majd értékként beilleszted (praktikus az első sort megtartani a képlet miatt).
-
#9984
Fire/SOUL/CD
félisten
Zomb€€
#9978
"Ezt be lehet építeni a makróba, hogy ne kelljen külön még átkódolni a .csv-t?"
1. Attól függ, milyen módszerrel hozza létre a makró a CSV fájlt
2. Az UTF8 mezei szöveges fájl, annyiban különbözik egy sima textfájltól, hogy az első 3 byte-ja rendre a következő (hexadecimálisan): 0xEF, 0xBB, 0xBF
3. Az ASCII->UTF8 valós konverziónak, akkor van csak értelme (a 2. pont túl), ha tényleg speciális karakterek kerülnek a CSV-be, pl: äöüß, amit a weben is meg akarnak jeleníteni. Valószínű, hogy ezzel a fájllal is ez van... Ha ez a szitu, akkor egy példaprogi
Private Sub CommandButton1_Click()
Dim My_Real_UTF8_Conversion As Object
Set My_Real_UTF8_Conversion = CreateObject("ADODB.Stream")
My_Real_UTF8_Conversion.Type = 2
My_Real_UTF8_Conversion.Charset = "utf-8"
My_Real_UTF8_Conversion.Open
My_Real_UTF8_Conversion.WriteText "ASCII nem fog változni, de ezek igen: äöüß"
My_Real_UTF8_Conversion.SaveToFile "d:\FSCD_UTF8.UTF8", 2
Set My_Real_UTF8_Conversion = Nothing
End Sub -
Delila_1
veterán
Az adataidnál speciális szűrővel gyűjtsd ki a képzési helyszíneket, csak az egyedi rekordokat. Legyen ez mondjuk a G oszlop. Mellé, a H oszlopba adj egy számot, az általad meghatározott területeknek azonosat, pl. a Budapest 1: Budapest 11-ig címeknek a száma legyen 1, a következő intervallumé legyen 2.
A képzési terület oszlop mellé tegyél be egy oszlopot, ami az fkeres függvénnyel minden sorba beírja az előbb adott számokat.
Jöhet a körlevél. A 3/6 lépésben a Körlevél címzettjei opcióban a Címzettlista szerkesztésénél kiválasztod az fkeres függvényt tartalmazó oszlopot, Speciális, ott megadod a terület számát. Ha itt 1-est adsz meg, az összes Bp. 1-11 területhez azonos szövegű körlevelet kapsz az egyesítés után.
Jöhet a másik szövegű egyesítés a kettes helyszínhez. (A fenti képen az az eset látható, amikor azonos szövegű levelet akarsz írni az egyes, és kettes helyszínhez.)
Nem vagyok biztos benne, hogy jól értettem a feladatot.
-
#9060
Fire/SOUL/CD
félisten
Zomb€€
#9059
-
#9058
Fire/SOUL/CD
félisten
Zomb€€
#9056
-
Zomb€€
őstag
Grr, nagyobb a probléma mint hittem. Inkább beírom az egészet, hátha más megközelítés kell neki,.
Szóval adott egy lekérdezés, melyben bizonyos emberek oktatási adatai vannak, többek között a helyszín is, ahova menne oktatásra.
A helyszínek mindig változóak lehetnek.
Ami még érdekes, hogy a helyszínekhez mindig más, és több oktató is tartozhat.
A bruttó listát pedig oktató szinten kell feldarabolni, tehát a gondolatmenetem szerint folyamatosan vizsgálni kéne a lekérdezés eredményében lévő helyszínt az alap adatokkal, ahova az oktatók vannak rögzítve, és a rögzített oktatók száma > 1 akkor az összes, oktatóhoz tartozó képzéshelyszínnel rendelkező rekordot el kell osztani az oktatók számával, és feltölteni velük arányosan (Mindig egyenlő arányban kéne)
Nem akar jönni az ihlet:-]Remélem érthető voltam
-
#8917
Fire/SOUL/CD
félisten
Zomb€€
#8916
Ha az a megoldás megfelelő, hogy meg kell nyitva lennie folyamatosan az adott munkafüzetnek, akkor van.
Itt 10 másodpercenként menti a munkafüzetet
Ha egy megadott időben szeretnéd menteni, akkor a linkben megadott kódban a módosítani kell ezt a sort mindkét helyen
Application.OnTime Now + TimeSerial(0, 0, 10), "SaveThisWorkBook", , True
erre:
Application.OnTime TimeValue("14:00:00"), "SaveThisWorkBook", , True
Így minden nap délután 2 órakor elmenti a munkafüzetet.
Értelem szerűen módosítva a kódot, azt futtatsz le így(olyan makrókódot), amire épp szükséged van.
[ Módosította: Ndruu ]
-
#8902
Fire/SOUL/CD
félisten
Zomb€€
#8901
De Én nem azt írtam
Egyenlőségjellel kezdődjön, mint egy képlet(ahogy írtam), és akkor működni fog. (Kipróbáltam és működik, nem írnám le ha nem működne )
tessék, itt az A és B oszlopok illetve még pár találomra kijelölt cellák üresek (beleírtam az ="" képletet az összes üres cellába) ez az eredmény mentés után, a Te makróddal:
-
#8900
Fire/SOUL/CD
félisten
Zomb€€
#8899
Hát azt csak úgy lehet, ahogy írtad. Ki kell jelölni az összes üres cellát, majd beírni az ="" "képletet" mindbe. Ezt természetesen fel lehet gyorsítani, nem kell egyenként elvégezni.
1. Szerkesztés/Ugrás/üres cellák kijelöl és OK
2. (Most ki van jelölve az összes üres cella), kezd el begépelni ezt ="", majd CTRL+ENTEREzáltal minden üres cellába bekerül a "semmi"...
-
#8898
Fire/SOUL/CD
félisten
Zomb€€
#8897
Igen, az remek "trükk", csak az a "gond" vele, hogyha egy másik gépen is lesz használva esetleg a munkafüzet és ott más nyelvű OS fut(vagy valamiért mások a területi beállítások), akkor voila, máris nem pontosvessző lesz...
Persze, ha csak és kizárólag a Te gépeden lesz használva az excel munkafüzet, akkor tökéletes megoldás.
-
#8896
Fire/SOUL/CD
félisten
Zomb€€
#8895
Ok, akkor inkább szavak helyett.
'itt add meg, mi legyen az ELVÁLASZTÓ karakter
Const MYDELIMITER = ";"
Dim MyCell As Range
Dim MyRow As Range
Dim MyCellValue As String
Dim MyFname As String
Dim MyFnum As Long
Dim MyRange As Range
Private Sub CommandButton1_Click()
'itt add meg a táblázatod tartományát
Set MyRange = Range("A1:B7")
MyFname = "D:\FIRE\" & Format(Now(), "yyyy.mm.dd") & ".csv"
If Not Dir(MyFname) = vbNullString Then
UserChange = MsgBox(prompt:="A fájl (" & MyFname & ") már létezik. Felülírja?", Title:="Megerősítés", Buttons:=vbYesNo)
If UserChange = vbYes Then WriteMyFile
Else
WriteMyFile
End If
End Sub
Private Sub WriteMyFile()
MyFnum = FreeFile
Open MyFname For Output As MyFnum
For Each MyRow In MyRange.Rows
For Each MyCell In MyRow.Cells
MyCellValue = MyCellValue & MyCell.Value & MYDELIMITER
Next MyCell
MyCellValue = Left(MyCellValue, Len(MyCellValue) - 1)
Print #MyFnum, MyCellValue
MyCellValue = ""
Next MyRow
Close MyFnum
End Sub -
#8894
Fire/SOUL/CD
félisten
Zomb€€
#8893
Szerintem elég egyértelműen fogalmaztam:
"A LISTAELVÁLASZTÓT(pontosvesszőről, ami az alapbeállítás magyar OS esetén) egy függőleges vonalra cseréltem"Ha magyar operációs rendszert használsz, akkor a területi beállításokban az alapértelmezett LISTAELVÁLASZTÓ a pontosvessző, ha meg pl Angol OS-t használsz, ott meg a vessző az alapértelmezett.
A makrót meg nem érdekli, hogy milyen OS-t használsz, az mindig vesszővel fogja elválasztani a CSV-t, ha azzal a módszerrel készíted, ahogy korábban beírtad(ActiveSheet.SaveAs)Jobban/érthetőbben nem tudom leírni...
-
#8892
Fire/SOUL/CD
félisten
Zomb€€
#8891
Az elsőre majd írok valamit, most nem sok időm van...
""Mentés másként -> CSV (pontosvesszővel tagolt)"
Ha így mented el, akkor az a területi beállításokra támaszkodik, íme a példaMentés másként -> CSV (pontosvesszővel tagolt)-ként mentettem, és ez az eredmény
A makrót nem érdekli a területi beállítás, az az angol beállításokat követi, angolul kell a függvényneveket megadni, a függvények paramétereit vesszővel kell elválasztani stb stb...
Ezért kell más elven megoldani a CSV fájl létrehozását, hogy az területi beállításoktól, a makró alapértelmezett(angol) nyelvétől függetlenül, mindig ugyanazt a formátumú(pontosvesszővel elválasztva, szövegek idézőjelek közt(vagy sem) stb stb) CSV-t produkálja... -
#8890
Fire/SOUL/CD
félisten
Zomb€€
#8889
Azért van, hogy idézőjelbe teszi a NINCS DÖNTÉS értéket, mert szóközt tartalmaz, ezt kikerülni nem lehet azzal a módszerrel, amit használsz (legalábbis én nem tudok róla).
Ezért kellene egy másik megoldást eszközölni.(természetesen megoldható, csak egy kicsit több meló, de tényleg csak kicsit több) -
#8888
Fire/SOUL/CD
félisten
Zomb€€
#8887
ActiveWorkbook.SaveAs Filename:="D:\FIRE\" & Format(Now(), "yyyy.mm.dd") & ".csv", FileFormat:= _
xlCSV, CreateBackup:=False"van egy több If-ből álló tömböm"
Ilyen nincs, ez így értelmetlen, bár tudom mire gondolsz.
Amikor az ActiveWorkbook.SaveAs segítségével mented a CSV-t, akkor nincs beleszólásod abba, hogy milyen karakterrel legyenek az elemek elválasztva, mint ahogy abba sem, hogy a szöveg/általános típusú értékeket idézőjelek közé tegye avagy sem.
Excel illetve az OS területi beállításai a mérvadók ebben az esetben. Ha tényleg "személyre szabott" CSV-t szeretnél létrehozni, akkor azt más módszerrel kell megoldani. -
#8884
lasarus1988
tag
Zomb€€
#8883
lasarus1988
tag
Zomb€€
If Instr("mák", cells(row, column))>0 Then
amit akarsz csinálni
End IfEgyébként nekem is lenne egy kérdésem:
Hosszú idejű pingelést írtam meg vb makróban és akad benne egy hiba, ez pedig a timer átfordulása. 86400 után 0-tól újrakezdi számolni a napot.
Ha csak pár órát mérek akkor működik így a dolog:
Start = Timer
Pause = 7200
Do While Timer < Start + Pause
mérés
LoopNa most, ha én több napig szeretnék mérni, akkor hogyan tudom megoldani ezt do while ciklussal? Próbálkoztam a now() függvénnyel de nem igazán jártam sikerrel.
-
#8879
Fire/SOUL/CD
félisten
Zomb€€
#8878
1. A help/súgó hasznos dolog, mert abból is sokat lehet tanulni, főleg, ha kezdeteknél még egy for-next ciklus felépítése/megírása is problémát okoz. Ezen felül ezt javaslom: [link]
A kezdőknek szánt könyvekben általában a VBA programozást szokták bemutatni, de olyan szinten, aminél a súgó többet ér, viszont az objektumok bemutatása, az ki szokott maradni az ilyen alap könyvekből. Na szóval ezért javaslom azt, amit fentebb...2. Range("A" & Rows.Count).End(xlUp).Row
Ez az A oszlop utolsó használt sorának a számát adja eredményül, remélem nem értettem félre a kérdésed... -
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
Hirdetés
Fferi50- Google Pixel topik
- Android alkalmazások - szoftver kibeszélő topik
- Nintendo Switch 2
- iPhone topik
- Hálózati / IP kamera
- Kazy Computers - Fehérvár - Megbízható?
- Counter-Strike: Global Offensive (CS:GO) / Counter-Strike 2 (CS2)
- Yettel topik
- Samsung Galaxy A55 - új év, régi stratégia
- Rábólintott az EU, eltakarítja az illegális termékeket az AliExpress
- További aktív témák...
- Antivírus szoftverek, VPN
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Telefon felvásárlás!! iPhone X/iPhone Xs/iPhone XR/iPhone Xs Max
- Eladó Apple iPhone Xr 64GB fekete / ÚJ KIJELZŐ / 100% AKKU / 12 hónap jótállással!
- Telefon felvásárlás!! iPhone 11/iPhone 11 Pro/iPhone 11 Pro Max
- Bomba ár! Lenovo IdeaPad 330S-15IKB - i5-8G I 8GB I 256SSD I 15,6" FHD I HDMI I Cam I W11 I Gari!
- IBM/Lenovo Thinkpad T60
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: Promenade Publishing House Kft.
Város: Budapest