-
IT café
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
-
Bobrooney
senior tag
válasz Delila_1 #22537 üzenetére
Nem, simán ha rámész a szűrőre, minden a hozzá tartozó adatot csak egyszer jelenít meg.
Erre a listára gondoltam: // Remélem most jó lesz a kép
Nem kell semmi speckó szűrés, csak a lista kiválasztható adataira lenne szükségem.
Meg elehetne oldani ilyen olyan kereséssel és több ciklusos hasonlítással, ezt szeretném elkerülni.[ Szerkesztve ]
-
-
slashing
senior tag
válasz Delila_1 #22555 üzenetére
jah azthiszem leesett tehát ha van 6 cserélendő akármim akkor növeljem a ciklust egyel kevesebb értékig tehát 0 to 5
(amúgy én azért inkább cserélnék veled hogy meg tudjam csinálni azt ami a problémám mint hogy keresgéljem kelljen bár ez tényleg mindig jól ment)
[ Szerkesztve ]
-
slashing
senior tag
válasz Delila_1 #22562 üzenetére
Bocsi nem voltam teljesen pontos a kijelölésig okés a dolog azzal abszolút nem kell foglalkozni csak a beillesztésen megy a variálás
usor = Workbooks(WBN).Sheets(WS).Cells(1 & Columns.Count).End(xlToLeft).Column + 1
selectRange.Copy
Workbooks(WBN).Sheets(WS).Cells(6, usor).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=FalseA kódod sokat segített annyi volt a hibám hogy a félkövér résznél & jelet használtam de átírva vesszőre már faszán egymás mellé kerülnek az adatok. most már csak annyi van hogy a B6-nál kezdi berakni az adatokat szóval el kéne tolni a D6-ig valahogy
A teljes kód itt van, tuti emlékszel rá mindig abból a könyvtárból húzza be az adatokat ami a lap neve. Jelen esetben a B4:B tartományból szedi ki az adatokat és kerülnek át
Sub XLSX()
Dim Filename, Pathname As String, WBN As String, WS As String
Dim wb As Workbook
Application.ScreenUpdating = False
WBN = ActiveWorkbook.Name
WS = ActiveSheet.Name
Pathname = "C:\bosch\" & WS & "\"
Filename = Dir(Pathname & "*.txt")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb, WBN, WS
Application.CutCopyMode = False
wb.Close SaveChanges:=False
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Sub DoWork(wb As Workbook, WBN, WS)
Dim usor As Long, cell As Range, selectRange As Range, WS2 As String
WS2 = ActiveSheet.Name
With wb
Dim cserelendo, b As Integer
'Kötőjellel elválasztva add meg a törlendő szavakat
cserelendo = Split("Tol*-Date*-Time*-File*-Lot*-No*-Distance(point-to-line)-'*-Actual-Nominal-Upper-Lower-Error-Judge-Pass-L", "-")
'a ciklus hosszának egyel kevesebbnek kell lennie mint a cserélendó szavak mivel a nullát is feltölti
For b = 0 To 17
Cells.Replace What:=cserelendo(b), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next
'itt adod meg melyik oszlopból vegye az adatokat, ha az első Range oszlopa nem egyzik a következő Range tartományával akkor ott fogja kijelölni ahol keresztezi egymást a kettő
usor = .Sheets(WS2).Range("B" & Rows.Count).End(xlUp).Row
For Each cell In .Sheets(1).Range("B4:B" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
'Itt adod meg melyik oszlopba pakolja az adatokat a Transpose True miatt lesz átfordítva oszlopból sorra
usor = Workbooks(WBN).Sheets(WS).Cells(1 & Columns.Count).End(xlToLeft).Column + 1
selectRange.Copy
Workbooks(WBN).Sheets(WS).Cells(6, usor).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub[ Szerkesztve ]
-
-
Delila_1
Topikgazda
válasz Delila_1 #22598 üzenetére
Az első kötőjel után a típusnál előfordulhat 9-nél nagyobb érték is, ezért a szám kinyeréséhez írtam egy függvényt, ezt kell alkalmaznod a C oszlopban.
Function Kozepe(cella As String)
Dim kar As Integer, tol As Integer, ig As Integer
tol = InStr(cella, "-") + 1
For kar = tol To Len(cella)
If Mid(cella, kar, 1) = "-" Then
ig = kar
Exit For
End If
Next
Kozepe = Mid(cella, tol, ig - tol)
End FunctionA makrót beviszed a VB szerkesztőbe, utána alkalmazhatod.
C3-ba: =kozepe(A3), és ezt másolhatod.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
slashing
senior tag
válasz Delila_1 #22613 üzenetére
Nah megpróbáltam beilleszteni ahogy írtad lefut szépen csak egy a bajom hogy addig jelöl ki amíg az A oszlopban adatok vannak. Az A oszlop az tök lényegtelen számomra mindig csak azt az oszlopot kéne nézni ahonnan akar másolni. Az első sorban B2-től vannak a kimenő fájlok nevei file1 file2 ....
alattuk az adatok.Sub adatokkimentese()
Dim sor, oszlop As Integer
Sheets("teszt").Select
sor = Range("A" & Rows.Count).End(xlUp).Row
oszlop = Cells(1, Columns.Count).End(xlToLeft).Column
For Each cell In Range(Cells(1, "B"), Cells(1, oszlop))
Range(Cells(2, cell.Column), Cells(sor, cell.Column)).Copy
Workbooks.Add
Range("A1").PasteSpecial
ActiveWorkbook.SaveAs Filename:= _
"C:\adatokki\" & cell.Value & ".xlsx"
ActiveWorkbook.Close
Next cell
Application.CutCopyMode = False
End Sub -
slashing
senior tag
válasz Delila_1 #22615 üzenetére
Áhh hülye vagyok b1,c1,d1.... filenevek
b2,3,4... akármeddig / c2,3,4 akármeddig és így tovább vannak az adatok
most addig jelöl ki míg a teszt szövegek vannak mivel az A lett meghatározva a Sor-ban de az lenne az igazi ha mindig csak az nézni amit éppen másolni akar
[ Szerkesztve ]
-
slashing
senior tag
válasz Delila_1 #22620 üzenetére
Istenigazából a végének nem is így kéne lennie de csak ebben voltam biztos hogy jó és le fog futni.
A véglegesben ennek úgy kéne mennie hogy a kiinduló lapon a D4,E4,F4 ben vannak a fájlnevek alattuk az adatok. Nem új fájlt kéné készíteni hanem azt megnyitni ami a D4-ben van és a megnyitott fájl D oszlopának mindig az első üres cellájába másolná át az adatokat hogy ne írja felül a már benne lévőket.
De azt hiszem feladom. A házépítést sem a tetőnél kezdik szóval nekem sem mindjárt a sűrűjével kéne. Veled meg nem akarom még ezt is megíratni.
(pedig a Pascal nyelv tök jól ment a suliban de most nem áll rá az agyam erre a VBA-ra)
[ Szerkesztve ]
-
foregister
tag
válasz Delila_1 #22602 üzenetére
Delila: Ez a VB script lett a megoldás végül (kis módosítás után). Nagyon szépen köszönöm!
Fferi: neked is köszönöm a segítséget, de valamiért nem sikerült úgy átültetnem a formulát a munkás excelbe, hogy ne #ÉRTÉKET-et adjon vissza. Azért vicces, mert szinte minden megegyezik csak adtam hozzá plusz oszlopokat kb. még 10-et.
A lényeg, hogy megoldódott, bár amennyit szívtam vele, manuálisan is megoldhatta volna, de legalább tanultam megint valamit excelben
Mind a kettőtöknek hálával tartozom!
Az igen az nem nem
-
Fferi50
őstag
válasz Delila_1 #22635 üzenetére
Szia!
Semmi gond.
Viszont a Clearcontents helyett a Delete kell, mert különben odatesz a végére néhány vesszőt (mert a usedrange-ban benne vannak azok a cellák is és értékük üres).
A végén még be is kellene zárni a CSV fájlt, az eredetit pedig nem szabad menteni.Én ennél egy kicsit - na jó sokkal - bonyolultabban képzeltem el a megoldást.
Üdv.
-
paatrick
őstag
válasz Delila_1 #22638 üzenetére
Elnézést de csak az excel felszínét kapargatom.
Szóval nem tudom mi az a "laphoz rendelt makró", képhez már rendeltem hozzá egy autoszűrő nullázót de ennyi.
Egyébként 3 szín is elég, ha a másik megoldás egyszerűbb.Ha kérhetem szájbarágósabban
K-tól AG celláig kéne vizsgálni, gondolom akkor ez így néz ki
Case "K"
Range(K-AG).Interior.Color = vbBlue6 év "lelkes újonc", 4 év "kvázi-tag", 2 év "tag", 1 év "aktív tag", már senior tag. I'm doing my part. ¯\ ʕ•ᴥ•ʔ /¯
-
Delila_1
Topikgazda
válasz Delila_1 #22653 üzenetére
Kicsit cifrázva:
A listbox tulajdonságainál a ColumnHeads legyen True.Cells(1,"AA")="Sorszám"
Cells(1,"AB")=Filename
Cells(loopcount+1, "AA")=loopcount
Cells(loopcount+1, "AB")=Filename
Sheets("Munka1").ListBox1.ListFillRange = "Munka1!AA2: AB" & loopcount+1
Sheets("Munka1").ListBox1.Visible = True[ 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.
-
maugly
csendes tag
válasz Delila_1 #22634 üzenetére
Nnna, eddig tartottam, teljesen belekavarodtam. Tejfog..
Próbálom a dátum formátumát belőni úgy, hogy ne kelljen használnom a Windows területi és nyelvi beállításait az általam kívánt yyyy-mm-dd alak eléréséhez az exportált csv-ben.
Volt egypár verzióm, egy része nem hozza a kívánt eredményt, más részét helytelen szintaktikával, vagy esetleg nem létező belső függvények miatt rontom el.
A változók megadása után próbáltam ezt a kettőt, a végeredményen nem látszik:
Columns("D:E").NumberFormat = "yyyy-mm-dd;@"Columns("D:E") = Format$(Date, "yyyy-mm-dd")
Aztán próbáltam a cikluson belül formázni. Google barátom találatai alapján próbálkoztam egy TEXT függvénnyel, amire azt mondta a Visual Basic, hogy szerinte ilyen nincs.
Próbálkoztam egy ilyennel, ezzel sem értem el a célt:
For oszlop = 1 To 6
If (oszlop = 4) Or (oszlop = 5) Then
formaz = ""
formaz = Format&(Cells(sor, oszlop), "yyyy-mm-dd")
uj = uj & formaz & "|"
Else: uj = uj & Cells(sor, oszlop) & "|"
End IfTuti van egy pofonegyszerű megoldás, de már nem látom az erdőmtől azt az egy fát.
[ Szerkesztve ]
"Csak gyerek-füllel-hallhatóan röhögök, mint a hintaló." /Fodor Ákos/
-
paatrick
őstag
válasz Delila_1 #22664 üzenetére
Oké, így már jól jelenik meg. Köszönöm.
Azonban felmerült egy probléma, ha egy új sort akarok beszúrni akkor mindig kidob egy hibát:
Microsoft Visual Basic
Run-time error '13':
Type mismatch
End, Debug, Help lehetőségekkel. Ha az End-re kattintok beszúrja a sort végül, a Debugnál a Case "K"-t jelöli meg.
Ki lehet kapcsolni, vagy ki lehet javítani valahogy?
[ Szerkesztve ]
6 év "lelkes újonc", 4 év "kvázi-tag", 2 év "tag", 1 év "aktív tag", már senior tag. I'm doing my part. ¯\ ʕ•ᴥ•ʔ /¯
-
Oly
senior tag
válasz Delila_1 #21707 üzenetére
Szia
Én ezzel indultam el:
=HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(HELYETTE(A5;"é";"e");"á";"a");"ő";"o");"ű";"u");"ú";"u");"ö";"o");"ü";"u");"ó";"o")
De ugyanezt még a nagybetűkre is meg kell csinálni.
Gondoltam, csinálok egy egyéni fügvényt rá, de elakadtam az elején.
Milyen parancsot használhatok rá?Köszi
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy - Galaxy S Advance - Galaxy S4 - Lumia 820 - Honor 7 - iPhone 5S
-
Oly
senior tag
válasz Delila_1 #22692 üzenetére
Szia
Valóban kimaradt, már pótoltam.
Az ASCII sem ment. Excelben és a forráskódban is Alt+0213-mal írtam be, de nem ismeri fel.
de kis guglizás után ezzel sikerült:
Function MAGYARIT(cella As String)
cella = Replace(cella, "é", "e")
cella = Replace(cella, "á", "a")
cella = Replace(cella, ChrW(369), "u")
cella = Replace(cella, ChrW(337), "o")
cella = Replace(cella, "ú", "u")
cella = Replace(cella, "ö", "o")
cella = Replace(cella, "ü", "u")
cella = Replace(cella, "ó", "o")
cella = Replace(cella, "í", "i")
cella = Replace(cella, "É", "E")
cella = Replace(cella, "Á", "A")
cella = Replace(cella, "Ú", "U")
cella = Replace(cella, ChrW(336), "O")
cella = Replace(cella, ChrW(368), "U")
cella = Replace(cella, "Ö", "O")
cella = Replace(cella, "Ü", "U")
cella = Replace(cella, "Ó", "O")
cella = Replace(cella, "Í", "I")
MAGYARIT = cella
End FunctionSonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy - Galaxy S Advance - Galaxy S4 - Lumia 820 - Honor 7 - iPhone 5S
-
slashing
senior tag
válasz Delila_1 #22738 üzenetére
jaj bocsi nem írtam hogy a range("d9") nem kell az csak azért volt ott hogy legalább valahova megkapjam az értéket
szóval ahova beírom oda kapjam vissza az értéket ahova írtam és fontos még hogy nem teljes oszlop mert címmel rendelkezik.
Egyébként azt meg tudod mondani hogy miért nem kell az inStr végén +1 vagy -1 stb karaktert hozzáadni? Mert az elején azzal szívtam hogy a szóköztől számítva kivontam két karakter bal-ra középtől meg hozzáadtam de úgy nem volt jó de mire ez leesett ááhhhggrrrr....
[ Szerkesztve ]
-
-
samfishR
senior tag
válasz Delila_1 #22759 üzenetére
Köszönöm szépen, így már jó lett!
Van még 1 kérdésem, remélem tudsz segíteni
Van 3 cella, mind3 százalékokat tartalmaz. Ezeknek az összegének pontosan 100%-nak kell lennie, nem lehet sem kevesebb, sem több. Erre kellene egy feltételes formázás anélkül, hogy plusz oszlopot szúrnék be amiben összeadom a cellákat azért, hogy azt ellenőrizze a feltételes formázás képlete. Ha pont 100%, akkor mind a 3 zöld, ha nem 100%, akkor pirosnak kellene lennie a celláknak. Megoldható valahogy? Köszönöm!
-
samfishR
senior tag
válasz Delila_1 #22762 üzenetére
Sikerült alkalmazni, köszi! Már csak az a kérdés, hogy egy egész oszlopban hogy tudom mindre ráhúzni ezt a formázást? Nekem sajnos vízszintesen vannak a cellák, ráadásul nem is egymás mellett. Formátummásoló nem veszi át a formázást. Az R T V oszlopokban vannak a százalékok, így néz ki:
-
-
botond187
csendes tag
válasz Delila_1 #22793 üzenetére
Azt kéne változtatni, hogy amit csináltál, ott az alap oszlopon belűl is egy -tól-ig részt kéne létrehozzni.
Amit küldtél táblázatot úgy kéne módosítani, hogy:Alap oszlop ezt kéne két részre szedni, szintén egy -tól - ig részre, és ami ezen értékek közé esik azokhoz rendelje a jelenleg is meglévő -tól és az -ig oszlopban levő termékeket
010100000-tól 010100099-ig levő termékekhez rendelje aTól oszlop (ezen nem kell változtatni)
010504000-tól termékeketIg oszlop (ezen sem kell változtatni)
010504099-ig termékeket
Új hozzászólás Aktív témák
- Milyen routert?
- Politika
- Kerékpárosok, bringások ide!
- Androidos fejegységek
- Trollok komolyan
- Otthoni hálózat és internet megosztás
- Még két színben megcsodálható az ár/érték trónra pályázó Moto
- War Thunder - MMO Combat Game
- Filmvilág
- callmeakos: Szabad e használt OLED televíziót venni?
- További aktív témák...
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Promenade Publishing House Kft.
Város: Budapest