-
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
-
Delila_1
Topikgazda
Alternatív megoldás FIRE megoldásával szemben:
Sub valami()
Dim sor As Integer
i = 40
For sor = 48 To 168 Step 2
Cells(sor, 4) = "='Alap tábla'!C" & sor - i
Cells(sor + 1, 4) = "='Alap tábla'!D" & sor - i
i = i + 1
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
félisten
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...[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Delila_1
Topikgazda
Fire válaszához annyit, hogy a lekérdezett sorszámot azonnal egy változóba teheted:
UtolsóSor=Range("A" & Rows.Count).End(xlUp).Row
ElsőÜresSor=Range("A" & Rows.Count).End(xlUp).Row+1Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
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.
[ Szerkesztve ]
-
félisten
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.[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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)Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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...[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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...
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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.
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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"...
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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:[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
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 ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
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
"Egyszer fent...egyszer fent!"
-
Delila_1
Topikgazda
Ez így elég nehezen követhető (vagy sehogy), próbálkozz kimutatás készítésével.
Ha nem megy, tedd ki a füzetet egy elérhető helyre – akár hamis adatokkal –, mindjárt nagyobb segítségre számíthatsz.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
félisten
Na ez már olyan feladat, amit nem Excel-el oldok meg, erre találták fel az Access-t... (legalábbis, amit én kiértek a feladatból)
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
-
Delila_1
Topikgazda
Szia!
Ha a jelenleti_temp az egyik lapod neve, akkor
sheets("jelenleti_temp").cells(X,2)=cells(X,2) & " " & cells(X,1)A concanetate (összfűz) függvényt nem kell kiírni, a munkalapon is gyosabb a
BX & " " & CX bevitele.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Úgy, hogy nem egyesíted.
Ha csak vízszintesen vannak egyesítve, megoldhatod a cellaformázásnál az oszlopok közt középre opcióval. Lehet, hogy a kijelölés közepére a becsületes neve a funkciónak.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
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.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
félisten
"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[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Delila_1
Topikgazda
válasz Zomb€€ #10170 üzenetére
Nem egészen világos nekem a kérdés (a kulcsokból is lehet 30-40 db), de lehet, hogy a kimutatás lesz a barátod.
Tegyél ki képet arról, amit össze szeretnél hozni.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
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).
-
Delila_1
Topikgazda
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 SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Zomb€€ #10452 üzenetére
Set terület=Range("A13:A1123")
A rá történő hivatkozásnál meg kell adnod a másik füzet nevét, és lapnevét.
workbooks("Másik_füzet.xls").sheets("Munka1").terület[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
válasz Zomb€€ #10456 üzenetére
A gyűjtő füzet aktív lapján állva
set másol = workbooks("ebből.xls").sheets("erről_a_lapról").range("a1:c1000")
usor=range("a1").end(xldown).row+1
másol.copy range("A" & usor)A gyűjtő füzetben az aktív lap A oszlopába másol, az első üres cellába.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
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.pasteProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Zomb€€
őstag
-
-
-
bugizozi
őstag
válasz Zomb€€ #11928 üzenetére
Hát nekem elsőre ez a megoldás jutott eszembe:
Application.DisplayAlerts = False
igaz hogy azt mondtad hogy nem elrejteni akarod, de ha ezt még nem próbáltad akkor hátha...
Esetleg a google találatai között hátha van olyan ami hasznos lehet számodra.VCP7-DCV, CCNA ||| Ami működik, ahhoz nem szabad hozzányúlni!
-
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
-
félisten
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...Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
Új hozzászólás Aktív témák
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! LEGOLCSÓBB! Automatikus 0-24
- Adobe Creative Cloud - 2024. 04. 05 - 2025. 04. 05-ig
- Windows 10/11 Home/Pro , Office OEM/Retail kulcsok
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.