-
PROHARDVER!
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
-
válasz
bozsozso #9716 üzenetére
Bocs a megkésett anyagért, de hétköznapokon el vagyok rendesen foglalva.
Ez a kód az összes CSV fájlt feldolgozza illetve AutoFilter-rel látja el. Ebből a táblázatból pedig kényelmesen legyárthatsz kimutatást, abban meg azt és úgy összesíthetsz, ahogy csak szeretnéd.
(Azért tettem be ide PH!-ra, mert hátha mások is találnak benne hasznos dolgokat)Private Sub CommandButton1_Click()
'elválasztó-karakter a CSV fájlokon belül
Const MYDELIMITER = ";"
'hol találhatóak a CSV fájlok
Const MYPATH = "D:\fire\csvs_path\"
'melyik munkalapra legyenek bemásolva az adatok
'(A munkalapnak LÉTEZNIE KELL!)
Dim DestWS As Worksheet
Set DestWS = Worksheets("Munka2")
'a megadott munkalap melyik cellájától kerüljenek be az adatok
Dim DestRange As Range
Set DestRange = DestWS.Range("A1")
Dim MyStr As String
Dim MyStrs() As String
Dim MyFileIndex As Integer
Dim MyRowCount As Integer
Dim MyCount As Integer
Application.ScreenUpdating = False
DestWS.Select
DestWS.UsedRange.Clear
DestRange.Select
MyRowCount = 0
MyFileIndex = 0
MyFname = Dir(MYPATH & "*.csv")
Do While Len(MyFname) > 0
MyFnum = FreeFile
Open MYPATH & MyFname For Input As MyFnum
Line Input #MyFnum, MyStr
Line Input #MyFnum, MyStr
Line Input #MyFnum, MyStr
If MyFileIndex = 0 Then
ActiveCell.Offset(MyRowCount, 0).Value = "TelephelyKód"
MyFileIndex = 1
MyStrs = Split(MyStr, MYDELIMITER)
If Right(MyStr, 1) = MYDELIMITER Then
MyCount = UBound(MyStrs())
Else: MyCount = UBound(MyStrs()) + 1
End If
For i = 0 To MyCount - 1
ActiveCell.Offset(MyRowCount, i + 1).Value = MyStrs(i)
Next i
MyRowCount = MyRowCount + 1
End If
Line Input #MyFnum, MyStr
Line Input #MyFnum, MyStr
While Not EOF(MyFnum)
Line Input #MyFnum, MyStr
xstr = Mid(MyFname, InStr(1, MyFname, ".", vbTextCompare) - 3, 3)
ActiveCell.Offset(MyRowCount, 0).Value = xstr
MyStrs = Split(MyStr, MYDELIMITER)
For i = 0 To MyCount - 1
ActiveCell.Offset(MyRowCount, i + 1).Value = Trim(MyStrs(i))
Next i
MyRowCount = MyRowCount + 1
Wend
Close MyFnum
MyFname = Dir()
Loop
With ActiveSheet
.Range(DestRange.Address & ":" & Chr(DestRange.Column + MyCount + 64) & DestRange.Row).AutoFilter
.Columns.AutoFit
End With
Application.ScreenUpdating = True
If MyRowCount = 0 Then MsgBox "A megadott termék nem található az átvizsgált CSV fájlokban.", vbInformation
Set DestWS = Nothing
Set DestRange = Nothing
End Sub -
-
válasz
bozsozso #9710 üzenetére
Akkor ezek lennének a feladatok?
1. Minden CSV első 4 sorának kihagyása
2. Terméknevek alapján létrehozni külön-külön munkalapokat, és abba pakolni a szükséges adatokatEhhez szükségem lenne egy CSV fájlra(ha publikus el is küldheted, ha nem, akkor meg készíts egy CSV kamu adatokkal, illetve erről
"Tehát új munkalap létrehozás majd pl.:a C1 cellába a terméknév utánna pedig pl. az A2-től a cellákban a telephelyek(ami fájlnév utolsó 3 karaktere) és mondjuk a B2 cellától lefelé a mennyiségek."
egy képet tegyél be...Delila_1
Köszönöm, éltetett. Igaz kicsit rövidre sikeredett, de legalább olyan ismerősökkel tudtam pár szót váltani, akikkel évek óta nem találkoztunk... -
-
-
válasz
bozsozso #9698 üzenetére
2 lehetőség van ekkor
1. Nincs 5. elem (MyStrs(4))
2. Nem egyforma formátumúak a CSV-kPuhatold ki melyik, és módosítom, kivitelezhető így és úgy is...
(Ma nem vagyok 100%-os, mivel (és ez lehet infó rólam pár emberkének), de Józsi vagyok és a barátokkal egy kicsit(tényleg kicsit) felöntünk a garatra...Holnap jelentkezem...
UI: Delila_1 tényleg egy "kis" zseni, bele sem merek gondolni, ha összehozott volna minket a sors az életben, milyen hiperkocka gyerkőceink lettek volna...
(Bocsi delila_1, remélem poénnak fogod fel, mert annak szántam) -
válasz
bozsozso #9681 üzenetére
No mindegy, majd kipróbálod, aztán ha valamit módosítani kell, akkor módosítva lesz...
Private Sub CommandButton1_Click()
'elválasztó-karakter a CSV fájlokon belül
Const MYDELIMITER = ";"
'hol találhatóak a CSV fájlok
Const MYPATH = "D:\fire\csvs_path\"
'melyik munkalapra legyenek bemásolva az adatok
Dim DestWB As Worksheet
Set DestWB = Worksheets("Munka2")
'a megadott munkalap melyik cellájától kerüljenek be az adatok
Dim DestRange As Range
Set DestRange = DestWB.Range("A1")
Dim MyStr As String
Dim MyStrs() As String
'meg kell adni, milyen terméket keressünk a CSV fájlok-ban és OK gomb
'Cancel gombbal megszakítható a művelet
UserChange = InputBox("Mit keressünk? (kis- és nagybetű nem számít...)", "Keresés...")
If Len(UserChange) > 0 Then
Application.ScreenUpdating = False
'kiválasszuk a megadott munkalapot
DestWB.Select
'töröljük annak teljes tartalmát
DestWB.UsedRange.Clear
DestRange.Select
MyRowCount = 0
MyFname = Dir(MYPATH & "*.csv")
Do While Len(MyFname) > 0
MyFnum = FreeFile
Open MYPATH & MyFname For Input As MyFnum
While Not EOF(MyFnum)
Line Input #MyFnum, MyStr
MyStrs = Split(MyStr, MYDELIMITER)
'vizsgáljuk, hogy a CSV fájl adott sorában, utolsó eleme után van-e még elválasztókarakter avagy sem
If Right(MyStr, 1) = MYDELIMITER Then
MyCount = UBound(MyStrs())
Else: MyCount = UBound(MyStrs()) + 1
End If
'a MyStrs(0) indexével adjuk meg, hogy a CSV fájlon belül, hányadik elem a termék neve
'első->0, második->1, harmadik->2 stb stb
If UCase(MyStrs(0)) = UCase(UserChange) Then
For i = 0 To MyCount - 1
ActiveCell.Offset(MyRowCount, i).Value = MyStrs(i)
Next i
MyRowCount = MyRowCount + 1
End If
Wend
Close MyFnum
MyFname = Dir()
Loop
Application.ScreenUpdating = True
'ha nem találtunk egyetlen megadott nevű terméket sem, arról értesítést adunk
If MyRowCount = 0 Then MsgBox "A megadott termék nem található az átvizsgált CSV fájlokban.", vbInformation
End If
Set DestWB = Nothing
Set DestRange = Nothing
End Sub -
-
-
válasz
bozsozso #9591 üzenetére
Megnyitod a munkafüzeted, amiben ezt a "furcsa" kerekítést használni szeretnéd, ALT+F11/Insert menü/Module és a megjelenő ablakba bemásolod az általam adott kódot. Mentés másként és makróbarát dokumentumként kell menteni immár.
Az a kód egy függvény, ugyanazok a szabályok érvényesek rá, mint pl a SZUM függvényre, azaz, egy adott cellán állva azt kell beírni, hogy pl =FSCD_Round5_9(A1)
-
perfag
aktív tag
válasz
bozsozso #9593 üzenetére
Előkészület: C2:igen, C3:nem - kijelölöd a cellákat amelyekre adatérvényesítést akarsz
Adatok menü, Adateszközök csoport, Érvényesítés parancs
A párbeszédablakban: Megengedve lenyíló: Lista - Forrásnak kijelölöd a C2:C3-at Ok
Ha akarod cifrázni próbáld ki a másik két fület is, beírsz valamiket és figyelszAz ok végrehajtása után a cellákon lenyíló jel jelenik meg. Lenyitod, kiválasztod. De beírhatsz is, ha elvéted akkor háborog. A háborgó üzenetedet a harmadik fülön magad megadhatod.
Lehet, hogy megint elütöttem valamit? Én radam kérdésére válaszolok éppen.
-
válasz
bozsozso #9584 üzenetére
Az alábbi kód szabályos KEREKÍTÉS-t végez először (5 tizedtől felfelé illetve az alatt lefelé), továbbá most úgy írtam, hogy a kerekítést követően a 2-re végződő számokat 5-re , míg 7-re végződőket 9-re módosítja. Próbáld ki, remélem így megfelel.
Function FSCD_Round5_9(xCell As Range) As Single
Dim xNumber As Single
Dim xStr As String, xChar As String
Dim MyFxs As WorksheetFunction
Set MyFxs = Application.WorksheetFunction
xNumber = xCell
xStr = MyFxs.Round(xNumber, 0)
xNumber = xStr
xChar = Right(xStr, 1)
Select Case xChar
Case "0"
xNumber = xNumber - 1
Case "1"
xNumber = xNumber - 2
Case "2"
xNumber = xNumber + 3
Case "3"
xNumber = xNumber + 2
Case "4"
xNumber = xNumber + 1
Case "5"
Case "6"
xNumber = xNumber - 1
Case "7"
xNumber = xNumber + 2
Case "8"
xNumber = xNumber + 1
Case "9"
End Select
Set MyFxs = Nothing
FSCD_Round5_9 = xNumber
End Function -
-
válasz
bozsozso #9485 üzenetére
=SZUMHA(A1:A4;"#";B1:B4)
Csillagot nem használhatsz, mert az ún. asterix karakter (helyettesítő karakter, mint akár a kérdőjel)
karczt
Az a baj, hogy pl a scroll lock esetén amit leírsz, annak úgy is kell működni.
Alfanumerikus ill. numerikus padon beírva a számot, akkor ugyanaz a helyzet? -
Delila_1
veterán
válasz
bozsozso #9011 üzenetére
Vigyázat! A számolás a megjelenítési formátumtól függetlenül a teljes számmal számol, nemcsak a látható részével. Előfordulhat, hogy az így formázott számok összege látszólag hamis eredményt ad.
Pl. a
364665 és
155723 összege
520388A látványuk
365 és
156, az összegük
520, ami látszólag hamis érték. -
válasz
bozsozso #9004 üzenetére
Basszuskulcs...
Emlékeztem egy nagyon egyszerű megoldásra, de ez valamiért nem akart működni, #,
Szóval egy kereszt és egy sima vessző és ez nem műxik, de megvilágosodtam, ez viszont pöpecül műxik, egyszerű cellaformázás és számolhatsz is vele utána# "e Ft"
Hát ez tényleg szívás volt, egy vesszőt lecseréltem szóközre...
m.zmrzlina
Nálam úgy ahogy leírtad (kötőjellel) nem működik... -
m.zmrzlina
senior tag
válasz
bozsozso #9004 üzenetére
Egyéni formátumkód létrehozásával meg lehet oldani.
Cellák formázása>Szám>Egyéni
Itt kiválasztod akármelyiket és átírod erre:
#-" e"
(a kettős kereszt után kötőjel van és ebben van a lényeg csak itt nem nagyon látszik) 1db kötőjel 1000-rel osztja a beírt számot. Ha milliókkal vagy milliárdokkal számolsz akkor többszörözni lehet a kötőjelet és persze utána "m" vagy "mrd"
Ezzel tudsz számolni is.
-
válasz
bozsozso #9002 üzenetére
"Egyszerű" cellaformázással (a legjobb tudomásom szerint) nem lehet, vagy felveszel egy segédoszlopot és abba beírod pl ezt =A1/1000 & "e Ft" vagy ez esetben elegánsabb és célszerűbb is egy makrót írni, ami figyeli, hogy ha az adott oszlopban/tartományban módosul egy cella tartalma, akkor automatikusan végigszalad az adott oszlopon/tartományon és elvégzi a szükséges formázást.
Természetesen a képlet amit feljebb írtam egy "nyers valami", ha szükséges(és általában az), akkor a kerekítésekről gondoskodni kell.
Új hozzászólás Aktív témák
Hirdetés
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- Antivírus szoftverek, VPN
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Assassin's Creed Shadows Collector's Edition PC
- Az ASUS TUF Gaming B550-Plus csak rád vár! Kamatmentes rèszletre is!!
- Xiaomi Redmi 12 Pro 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- Honor Magic7 Lite 8/512GB, Kártyafüggetlen
- Samsung Galaxy S23 Ultra , 8/256 GB , Kártyafüggetlen
- HP Omen - 27" IPS - UHD 4K - 144Hz 1ms - NVIDIA G-Sync - FreeSync - HDR 400 - USB-C - KVM Switch
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest