-
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
-
válasz
Pityke78
#50682
üzenetére
Ha csak azz adott sorokban kell viszgalni, akkor en inkabb feltetels formazassal oldanam meg. Ha angol Exceled van, akkor jelold ki az osszes cellajat, ahol kivalaszthato az ember, ugy hogy az elso sor elso oszlopa (C2 a kepen) kivalasztott mezo az aktiv:
Conditional Formatting -> New:
Es az eredmeny ilyen lesz:
Fuggveny:=COUNTIF($C2:$L2,C2)>1Persze ha nem C-oszloppal kezdodik, vagy L-lel vegzodik, akkor a formulaban azt javitani kell.
-
válasz
Pityke78
#50674
üzenetére
Szoval lehet idopont utkozes/atfedes es a kepletnek ezt is le kell tudni kezelni?
Eselteg tobb mint ket egymast koveto sor is lehet atfedo, vagy bennfoglalo? A sorok idorendi sorrendben vannak?
Ilyen lehet pl?
Hetfo 08:00 - 12:00
Hetfo 09:00 - 10:00
Hetfo 09:30 - 16:00
Hetfo 13:00 - 15:00 -
válasz
andreas49
#50635
üzenetére
Illetve:
Sub AR_BAL_1_mod()
Dim ws As Worksheet
For Each ws In Workbooks("c:\temp\Munkafüzet15.xls").Worksheets
If ws.Type = xlWorksheet Then
ws.Range("AM4:AQ155").FormulaLocal = "=Bal(E4;1)"
ws.Range("AS4:AW155").FormulaLocal = "=Bal(N4;1)"
ws.Range("AY4:BC155").FormulaLocal = "=Bal(W4;1)"
ws.Range("BE4:BI155").FormulaLocal = "=Bal(AF4;1)"
End If
Next
End Sub -
válasz
andreas49
#50632
üzenetére
Sub minden_munkalapra()
Dim ws As Worksheet
' Ide johet kozvetlen hivatkozas is ActiveWorkbook helyett
' pl Workbooks("akarmi.xls")
For Each ws In ActiveWorkbook.Worksheets
If ws.Type = xlWorksheet Then
' ide jon a kodod, csak az ActiveSheet vagy mas sheet hivatkozast ws-re kell cserelni
' ...
End If
Next
End Sub -
#50606
sztanozs
veterán
Hegyirabló
#50605
-
-
Ha garantált a felhasználónevek egyedisége, akkor lehet azzal is játszani. Látrehozol mindenkinek egy sheet-et, ahol a sheet neve a felhasználónév, és beállítod az alábbi makrót a ThisWorkbook alá:
Private Sub Workbook_Open()
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim WSHnet As Object, ws As Worksheet, UserID As String
Set WSHnet = CreateObject("WScript.Network")
UserID = WSHnet.UserName
Set WSHnet = Nothing
For Each ws In Worksheets
If ws.Name = "Unauthorized" Then
ws.Visible = xlSheetVisible
ElseIf ws.Name = UserName Then
ws.Visible = xlSheetVisible
Worksheets("Unauthorized").Visible = xlSheetVeryHidden
Else
ws.Visible = xlSheetVeryHidden
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Workbook_Open
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name = "Unauthorized" Then
ws.Visible = xlSheetVisible
Else
ws.Visible = xlSheetVeryHidden
End If
Next
End Sub -
-
O365: TEXTJOIN függvény
Makró megfelelője (direkt fordítva elnevezve, hogy ne ütközzön):
Public Function JoinText(Delimiter As String, SkipEmpty As Boolean, ParamArray Source() As Variant) As String
Dim AllResults, Value, Area As Range, CRange
Set AllResults = CreateObject("System.Collections.ArrayList")
For Each Value In Source
If TypeName(Value) = "Range" Then
For Each Area In Value.Areas
If Area.Count > 1 Then
For Each CRange In Area.Value2
If Not (IsEmpty(CRange) And SkipEmpty) Then AllResults.Add CRange
Next
Else
If Not (IsEmpty(Area.Value2) And SkipEmpty) Then AllResults.Add Area.Value2
End If
Next
ElseIf TypeName(Value) = "String" Then
If Not (IsEmpty(Value) And SkipEmpty) Then AllResults.Add Value
Else
If Not (IsEmpty(Value) And SkipEmpty) Then AllResults.Add str(Value)
If Err Then
Err.Raise 2000, Description:="Invalid source data type provided"
Err.Clear
End If
End If
Next
JoinText = Join(AllResults.ToArray(), ",")
Set AllResults = Nothing
End Function -
Tudja valaki, miért nem működik a villámkitöltés nálam?
Van egy táblám, ami kb 90 soros, és a fejléce a 8. sorban kezdődik.
Ezt akartam megnövelni még 20 sorral, de nem sikerült úgy kijelölnöm és "lehúznom" a sorokat, hogy folytassa a számozást. 5-10 perc nyűglődés után végül képlettel oldottam meg...BTW a tábla O365-ön, Teams alatt megosztva van.
-
válasz
Dilikutya
#49086
üzenetére
Ez nem biztos, hogy kivitelezhető - pontosabban, kérdés, hogy mi a pontos követelmény...
pl
1) mi a különbség Jan 28 és Feb 28?
- 1 hónap, vagy 31 nap?
2) mi a különbség Jan 31 és Feb 28?
- 28 nap, vagy?
3) mi a különbség Feb 1 és Márc 1 között?
- megint 1 hónap, vagy szintén 28 nap (vagy 29, ha szökőév van)? -
-
#48618
sztanozs
veterán
Fire/SOUL/CD
#48616
válasz
Fire/SOUL/CD
#48616
üzenetére
Ez szerintem nem igazán jó, mert utána már nehéz számolni vele.
-
válasz
ReSeTer
#48249
üzenetére
Mik a hibák?
Illetve próbáld meg egyesével hozzáadni a Watches ablakhoz a az összes szintet, és nézd meg, hol veszik el a referencia:wordappwordapp.ActiveDocument
wordapp.ActiveDocument.Sections
wordapp.ActiveDocument.Sections.Item(1)
wordapp.ActiveDocument.Sections.Item(1).Footers
wordapp.ActiveDocument.Sections.Item(1).Footers(wdHeaderFooterPrimary)wordapp.ActiveDocument.Sections.Item(1).Footers(wdHeaderFooterPrimary).Rangewordapp.ActiveDocument.Sections.Item(1).Footers(wdHeaderFooterPrimary).Range.Textwordapp.Selection -
VBA-val kell egy Split makró, ami megcsinálja:
Public Function SPLITTEXT(Text, Optional Separator = "") As Variant
If Separator <> "" Then
SPLITTEXT = Split(Text, Separator)
Else
SPLITTEXT = Split(Text)
End If
End FunctionUtána a következő worksheet függvénnyel lehet sorokba szétszedni:
=TRANSPOSE(SPLIT(A1, ","))
Office 365-ben nem is kell Array (CTRL+ENTER) forma a beíráshoz, megcsinálja magától a kiterjesztést. -
Meg lehet valahogy oldani, hogy Táblázat-ot használva lefixáljunk egy mezőt (mintha sima range lenne)? Ha elhúzom a függvényt, akkor "odéb húzza" a táblázat mezőjét is:
B1: = XLOOKUP($A1, Table1[col1], Table1[col2])
ez eggyel jobbra húzva ez lesz:C1: = XLOOKUP($A1, Table1[col2], Table1[col3]) -
#48139
sztanozs
veterán
dreizwanzig
#48138
válasz
dreizwanzig
#48138
üzenetére
1) Filter
2) Cellák kijelölése
3) Find & Search > GoTo Special...
4) Visible cells only
5) Conditional formatting ... -
#47733
sztanozs
veterán
Dark Archon
#47732
válasz
Dark Archon
#47732
üzenetére
igen, ha
1) átadod a funkciónak;
2) funkcióból is elérhető objektumban (pl. Application, Selection, Current*) vannak;
3) az értéket nem egy lokális, hanem egy globális változóba rakod.Kb ugyanaz, mint a JS amúgy.
-
#47723
sztanozs
veterán
Dark Archon
#47722
válasz
Dark Archon
#47722
üzenetére
:thumbsup:
-
#47721
sztanozs
veterán
Dark Archon
#47720
válasz
Dark Archon
#47720
üzenetére
Három ötletem van:
1) a FormulaR1C1 nem fér össze az "$A$11" nevezékkel
2) ha egy helyen full notation-t használsz, akkor mindenhol az kell
3) próbáld meg pontosvessző helyett veszzővel beadni a formulátPlusz egy javaslat: ha úgy is makróval húzod össze a sheeteket, akkor kézzel fűzd össze a szövegeket és csak rakd bele az eredményt a cellába.
-
#47713
sztanozs
veterán
MostaPista
#47712
válasz
MostaPista
#47712
üzenetére
Ha a zöld jelet a 0 fokra forgatod, akkor kelet pontosan 90, dél 180, nyugat pedig 270 fok irányában lesz.
Vagy téged az érdekel, hogy a 18 fok és 221 fok között van 157 fok?
Akkor a válasz:
=ABS(ABS(ABS(A1-B1)-180)-180)Ahol az A1 az egyik B1 a másik irány cellája (fokban)
-
#47506
sztanozs
veterán
Lasersailing
#47505
válasz
Lasersailing
#47505
üzenetére
Igen, regisztrálj egy jövőbeli eseményt (pont mint JavaScriptben) a lekérés végén:
https://stegriff.co.uk/upblog/non-blocking-wait-or-sleep-in-office-vba/ -
#47503
sztanozs
veterán
Lasersailing
#47496
válasz
Lasersailing
#47496
üzenetére
Miért nem menti el a makró a változásokat?
-
#43252
sztanozs
veterán
Csokishurka
#43251
válasz
Csokishurka
#43251
üzenetére
Sumif/szumha függvényt keresed
-
válasz
Alex123
#43218
üzenetére
Sub Macro1()
'
' Macro1 Macro
'
'
lastrow = 11 'annyira kell módosítani, amelyik az utolsó sor
For r = 2 To lastrow
Range(Cells(1, 1), Cells(r, 4)).Select
Selection.Copy
Cells(lastrow + r * 2, 1).Select
ActiveSheet.Pictures.Paste
Cells(r, 1).EntireRow.Hidden = True
Next
Range(Cells(1, 1), Cells(lastrow, 1)).EntireRow.Hidden = False
End Sub -
-
válasz
Sunsetjoy
#43062
üzenetére
valami ilyesmi (fejből):
cols = Array("C", "E", "F", "G", "I", "J", "K", "L", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AI", "AJ", "AL", "AM")
for ix = 0 to ubound(cols)
Range(cols(ix) & ":" & cols(ix)).Clear
next -
-
válasz
Protezis
#43004
üzenetére
Megoldásként szóba jöhet, hogy lemakrózod a fájlt és veryhidden-re állítod azokat a lapokat amelyek érzékenyek (jelszavas azonosítással). Akkor kézzel nem lehet megjeleníteni őket (nem látszanak az Unhide sheets ablakban).
Persze ettől még kézzel ki hozzá lehet férni az adatokhoz "hátulról".Én ezt mindenesetre nem excelben csinálnám...
-
válasz
lanszelot
#43001
üzenetére
Booklet módban kell nyomtatni, ha támogatja a nyomtató.
Xerox pl:
Wordben viszont nem kell nyomtató támogatás, tudja alapból is:
https://support.office.com/hu-hu/article/f%c3%bczet-vagy-k%c3%b6nyv-l%c3%a9trehoz%c3%a1sa-a-wordben-dfd94694-fa4f-4c71-a1c7-737c31539e4a?ui=hu-HU&rs=hu-HU&ad=HU -
-
válasz
daddy9
#42785
üzenetére
Szerintem erre a Word körlevél bőven elég, nem kell makró, meg ilyenek:
https://support.office.com/hu-hu/article/k%C3%B6rlev%C3%A9l-funkci%C3%B3-haszn%C3%A1lata-a-t%C3%B6meges-e-mailhez-levelekhez-c%C3%ADmk%C3%A9khez-%C3%A9s-bor%C3%ADt%C3%A9kokhoz-f488ed5b-b849-4c11-9cff-932c49474705 -
válasz
RAiN91
#42699
üzenetére
Nézd meg debuggerrel, hogy melyik sorral/objektummal van gondja:
Set WB = Workbooks("C:\mappa\asd.xlsx")
Set WS = WB.Worksheets("Diagram")
Set R = Range("A45")
Range("C8") = RHa az utolsóval, akkor
Range("C8").Value2 = R.Value2
'vagy
Range("C8").Value2 = Workbooks("C:\mappa\asd.xlsx").Worksheets("Diagram").Range("A45").Value2
Hogy explicit legyen, hogy csak értéket adsz át -
válasz
Gabiwan
#42682
üzenetére
Makró és Regex kell ehhez.
Public Function RegExExtract(Text As String, Expression As String) As String
Dim result As String
Dim AllMatches As Object
Dim Match
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = Expression
RE.Global = True
RE.IgnoreCase = True
Set AllMatches = RE.Execute(Text)
If AllMatches.Count <> 0 Then
For Each Match In AllMatches.Item(0).SubMatches
If Match <> "" Then
result = Match
Exit For
End If
Next
'result = allMatches.Item(0).submatches.Item(0)
End If
RegExExtract = result
End FunctionRegex:
(^\d?x*[ls]\s|^m\s|\s\d?x*[ls]\s|\sm\s|\s\d?x*[ls]$|^m$)Munkalap kód:
=TRIM(RegExExtract(A1;"(^\d*x*[ls]\s|^m\s|\s\d*x*[ls]\s|\sm\s|\s\d*x*[ls]$|^m$)")) -
#42454
sztanozs
veterán
szőröscica
#42451
válasz
szőröscica
#42451
üzenetére
Ami ebben a sorban előáll az URL paraméterben, amikor a hibát kapod:
.Open "POST", URL, False -
#42447
sztanozs
veterán
szőröscica
#42441
válasz
szőröscica
#42441
üzenetére
Próbáld meg az adott gépen IE-ben megnyitni a linket, és ha nem nyílik, vagy cert hiba van, akkor látni fogod.
-
#42434
sztanozs
veterán
szőröscica
#42433
válasz
szőröscica
#42433
üzenetére
Bár nem szorosan a témához tartozik, de célszerű minden változót lokálisan kezelni és ha kell, a függvénynek átadni. A másik pedig az
Option Explicithasználata. Ez megakadályozza a definiálatlan változók használatát, ami szintén gyakori problémaforrás.Szvsz egyébként az lehet a gond (nem látom a konkrét lekérést), hogy az
MSXML2.XMLHTTPnem kezeli jól a certificate hibákat és az adott gép valamiért nem tudja leellenőrizni az oldal tanúsítványát.
Célszerű leellenőrizni a certificate store-t a gépen, vagyMSXML2.XMLHTTPhelyettMsxml2.ServerXMLHTTP.6.0-t használni (ezzel viszont neked kell feldolgoznod a header-t és kezelni a cookie-kat): [link] -
#42431
sztanozs
veterán
szőröscica
#42427
válasz
szőröscica
#42427
üzenetére
1) nem látom, hogy a boundary definiálva lenne
2) nem xml adat amit átadsz (nem beszédes a változónév)
3) nincsenek definiálva a változók
Nem bonyolítod el ezt egy kicsit?Én így küldök GET/POST ützenetet:
Public Function CMD_ServiceXML(ByRef Vars As Variant, Query As String, Optional Method As String = "GET") As Object
Dim strResponse As String
Dim objHTTP As Object
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
If IsArray(Vars) Then
Dim var, vx
vx = 0
For Each var In Vars
Query = Replace(Query, "{" & vx & "}", URLEncode(CStr(var)))
vx = vx + 1
Next
Else
Query = Replace(Query, "{0}", UCase(Vars))
End If
If UCase(Method) = "GET" Then
objHTTP.Open "GET", Query, False
objHTTP.Send
ElseIf UCase(Method) = "POST" Then
Dim URI
URI = Split(Query, "?")
objHTTP.Open "GET", URI(0), False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send URI(1)
Else
Set CMD_ServiceXML = Nothing
End If
If objHTTP.statusText = "OK" Then
strResponse = objHTTP.ResponseText
Set objHTTP = Nothing
Else
Set CMD_ServiceXML = Nothing
Set objHTTP = Nothing
Exit Function
End If
Set CMD_ServiceXML = CreateObject("Msxml2.DOMDocument.3.0") ''// Using MSXML 3.0
On Error Resume Next
CMD_ServiceXML.LoadXML strResponse
If err Then
Debug.Print "<CMD XML>", Vars, strResponse
err.Clear
Set CMD_ServiceXML = Nothing
End If
On Error GoTo 0
End Function -
#42355
sztanozs
veterán
dellfanboy
#42353
válasz
dellfanboy
#42353
üzenetére
És akinek A-12345, AB-1234, ABCD-12, ABCDE-1 vagy CD-12345 formátumú rendszáma van (illetve a külföldiek)?
-
-
CTRL+lefele gombbal tudsz a kitöltött oszlop utolsó elemére lépni, ha folytonos a kitöltés.
Ha nem folytonos, akkor az üres mező előtti utolsó adatot tartalmazó mezőre lép (illetve utána a következő első adatot tartalmazóra és így tovább).
Valamint meg tudod tenni, hogy elrejted az összes nem használt sort és akkor nem görget tovább. -
válasz
sztanozs
#42117
üzenetére
Csináltam ehhez egy teljesen általános megoldást, három Named Range-dzsel:
_C0 - Azonosító oszlop első elemére mutató Range (abszolút címzéssel, a példában Sheet2-n B2 mező, de lehet akárhol, bármelyik munkalapon)=Sheet2!$B$2
_C1 - Dinamikos Range a számoláshoz=OFFSET(_C0,0,0,ROW()-Row(_C0)+1,1)
_C2 - A Kalkulátor (ezt kell megadni a formázás feltételeként)=NOT(MOD(SUM(SIGN(FREQUENCY(MATCH(_C1,_C1,0),ROW(_C1)-Row(_C0)+1))),2))A formázáshoz
1) ki kell jelölni az azonosító mező első elemét és elnevezni_C0-nak
2) be kell regisztrálni a fenti_C1és_C2Named Range-eket (copy-paste).
3) ki kell jelölni a teljes formázandó táblázatot
4) új feltételes formázást készíteni és kiválasztani az utolsó lehetőséget (Formula alapján)
5) formázást beállítani (háttér kitöltést valami másra, mint az alap)
6) formulába beírni:=_C2
Voila. -
Pl beraksz egy segéd oszlopot ezzel a függvénnyel (D oszlopra írtam meg):
=IF(B2=B1;D1;IFERROR(NOT(D1);TRUE))
Feltételes formázásra meg ezt:Formula: =$D2
Formázásra meg valami kitöltést.Segédoszlop nélkül ez kicsit bonyolultabb.
Kell pár named range (adott sheet-re beállítva):CTC: =OFFSET($B$2;0;0;ROW()-1;1)
_C1: =SIGN(FREQUENCY(MATCH(CTC;CTC;0);ROW(CTC)-1))=SIGN(FREQUENCY(MATCH(CTC;CTC;0);ROW(CTC)-1))Feltételes formázás formulája pedig:
Formula: =NOT(MOD(SUM(_C1);2)) -
#40824
sztanozs
veterán
pero19910606
#40823
válasz
pero19910606
#40823
üzenetére
makróval meg lehet csinálni, de ez csak akkor fog működni, ha megnyitáskor engedélyezik a makrót (vagy ha digitálisan aláírt a makró, a tanúsítvány megbízható a futtató gépeken és nincs letiltva minden makró futtatása).
-
#40708
sztanozs
veterán
Laciahegyrol
#40706
válasz
Laciahegyrol
#40706
üzenetére
Nem látok hibát:
-
#40702
sztanozs
veterán
Laciahegyrol
#40701
válasz
Laciahegyrol
#40701
üzenetére
Nem kezeli úgy, csak nem tudja az UI megjeleníteni Unicode karakterként. Amúgy milyen Office verziót használsz? Nálam simán működik:
-
SendKeys "{End}"se működik?Esetleg ez lehe a probléma:
SendKeys Not Working From Shortcut
If you try to run a macro with a keyboard shortcut, and that macro uses the SendKeys method, the SendKeys method might not work. To solve the problem, you can add a 1 second (or slightly longer) Wait line in the macro, before the SendKeys:Application.Wait (Now() + TimeValue("00:00:01"))
Új hozzászólás Aktív témák
- EAFC 26
- Házimozi haladó szinten
- btz: Internet fejlesztés országosan!
- Giga akkumulátort kínál a OnePlus Ace 6
- Path of Exile (ARPG)
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Építő/felújító topik
- Okos Otthon / Smart Home
- Kuponkunyeráló
- Debrecen és környéke adok-veszek-beszélgetek
- További aktív témák...
- BESZÁMÍTÁS! Asrock B450M R7 3700X 16GB DDR4 512GB SSD RTX 2070 Super 8GB GameMax Aero Mini ECO 600W
- Telefon szerviz helyben - Gyors javítás, akár 30 perc alatt!
- Apple iPhone 15 Pro 128GB, Kártyafüggetlen, 1 Év Garanciával
- Vállalom FRP Lock os telefonok javítását ingyen kiszálással és akár helyszíni javittással
- HIBÁTLAN iPhone 13 256GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS3421
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest