- Luck Dragon: Asszociációs játék. :)
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Kempingezés és sátrazás
- sziku69: Fűzzük össze a szavakat :)
- gban: Ingyen kellene, de tegnapra
- Geri Bátyó: B550 szűk keresztmetszet, de mi és miért?
- Chosen: Canon 5D II - portrézás 2025-ben
- Doky586: Helyreállítási partíció létrehozása (javítása)
- Gurulunk, WAZE?!
- bitpork: Augusztus 2- szombat jelen állás szerint.
-
LOGOUT
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
-
poffsoft
veterán
válasz
poffsoft
#37556
üzenetére
Nos, eddig jutottam.
Az utolsó sor kijelölése már nem sikerül, így a selection miatt rossz területen változik a stílus.
Valaki?
Public Sub masol()
Dim WSheets As Integer, WS1 As Worksheet, WS2 As Worksheet
Dim b As Range
Dim usor As Long, sor As Long, oszlop As Integer
Dim myPath As String
Dim folderPath As String
Dim MyText As String
Dim MyRange As Object
Dim myWRange As Object
Set Wordapp = CreateObject("word.Application")
For WSheets = 1 To 1 'Worksheets.Count
Set WS1 = Sheets(WSheets)
folderPath = Application.ActiveWorkbook.Path
usor = Range("A" & Rows.Count).End(xlUp).Row + 1
With Wordapp
.documents.Open folderPath & "\temp.docx"
a = .documents.Count
.documents(a).SaveAs Filename:=folderPath & "\" & WS1.Name & ".docx" ', FileFormat:=wdFormatDocumentDefault
.Visible = True
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
MyText = WS1.Range("A1")
.documents(a).Range.InsertAfter (MyText)
.Selection.Style = .documents(a).Styles("List_M")
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
MyText = "C. Témacsoportok az üzem-specifikus kérdésekhez"
.documents(a).Range.InsertAfter (MyText)
.Selection.Style = .documents(a).Styles("List_0")
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
For oszlop = 3 To 31
For sor = 6 To 8
MyText = WS1.Cells(sor, oszlop)
If MyText <> "" Then
.documents(a).Range.InsertAfter (MyText)
.Selection.Style = .documents(a).Styles("List_" & sor - 5)
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
End If
Next sor
For sor = 10 To usor
If WS1.Cells(sor, oszlop) <> "" Then
.documents(a).Range.InsertAfter (WS1.Cells(sor, 1))
.Selection.Style = .documents(a).Styles("List_norm")
.documents(a).Range.InsertparagraphAfter
'ITT KELLENE AZ UTOLSÓ SORT KIJELÖLNI
End If
Next sor
Next oszlop
MyRange.Selection.Collapse Direction:=wdCollapseend
.documents(a).Range.InsertparagraphAfter
End With
Wordapp.documents(a).Close
Next WSheets
Wordapp.Quit
End Sub -
poffsoft
veterán
Sziasztok,
egy olyan makró kellene nekem, ami :
Megnyitja a temp.docx fájlt,
Az A1 cellaérték névvel menti másként (ha létezik a név, felülírja),
A B1 cella tartalmát "Stílus1" szövegstílussal bemásolja a fájlba,
A C1 cella tartalmát "Stílus2" szövegstílussal bemásolja a fájlba,
Bezárja az új fájlt.Egy bonyolultabb táblázat feldolgozásához kellene ezzel elindulnom.
Köszi!
-
poffsoft
veterán
válasz
Capella
#35504
üzenetére
A J2 tartalma egészen pontosan milyen formátumban tartalmazza az utolsó cella címét? R1C1, vagy A1 vagy más? Ha A1 a formátum:
Sub GotoLastCell()
'
' GotoLastCell Makró
'
' Billentyűparancs: Ctrl+n
'
' Range("J2").Select
' Selection.Copy
' Application.Goto Reference:="R3135C6"
' ActiveCell.Select
' Application.CutCopyMode = False
Range(Range("J2")).Select
End Sub -
#35399
poffsoft
veterán
Juditta_56
#35397
poffsoft
veterán
válasz
Juditta_56
#35397
üzenetére
A koordináta változóid fele variant, fele integer. Szándékos?
Van "1" nevű munkalapod?
Hol index-szel (sheet(1)), hol névvel (sheets(1)) hivatkozol rá. Szándékos?
A range-n belül a cells biztos, hogy nem 0. oszlopra hivatkozik? (Osszoszl, Osszoszlmax nem nulla?) -
poffsoft
veterán
válasz
patesz
#35385
üzenetére
szia,
a ZZ lap A1 cellától ezt a képletet írd be tetszőleges (sok) sorba:
=HA(SOR()<=DARAB2(XX!A:A)-3;INDIREKT("XX!A"&SOR()+3);HA(SOR()<=DARAB2(XX!A:A)+DARAB2(YY!A:A)-6;INDIREKT("YY!A"&SOR()-DARAB2(XX!A:A)+6);""))ha a "B" oszlop is kell, akkor a B1-től lefelé ezt írd be:
=HA(SOR()<=DARAB2(XX!A:A)-3;INDIREKT("XX!B"&SOR()+3);HA(SOR()<=DARAB2(XX!A:A)+DARAB2(YY!A:A)-6;INDIREKT("YY!B"&SOR()-DARAB2(XX!A:A)+6);"NaN")) -
poffsoft
veterán
válasz
logitechh
#35063
üzenetére
Sub beillesztes()
'
' előre másik munkalapból kimásolt 4 oszlop szélességü tartományt beilleszt a B oszlop első üres sorától kezdve a B oszloptól az E oszlopig majd az A oszlopot kitölti sorszámmal illetve az F oszloptól az L oszlopig az F2:L2 tartomány képleteit másolja be addig a sorig ameddig a B oszlop tartalmaz elemet
'
Dim Asor As Long
Dim Bsor As Long
Dim i As Integer
Asor = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("B" & Asor).PasteSpecial xlPasteValues
Bsor = Range("B" & Rows.Count).End(xlUp).Row
Range("F2:L2").Copy Destination:=Range("F" & Asor & ":F" & Bsor ) 'a végén a -1 azt jelzi hogy nem az utlsó kitöltött sor plusz egy sorba másolja a képletet hanem csak az utolsó sorig
For i = Asor To Bsor 'számláló rész a Bsor esetén plusz egy sort beszámoz viszont ha csak a kitöltött celláig akarunk számozni akkor a-1 kell
Range("A" & i) = Range("A" & i - 1) + 1
Next i
'innen kezdődik a keretezés
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End Sub -
poffsoft
veterán
válasz
logitechh
#35039
üzenetére
egyszerűbb lett volna az elején elmondanod, mik vannak.
Sub mm()
Dim Asor As Long
Dim Bsor As Long
Dim i As Integer
Asor = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("B" & Asor).PasteSpecial xlPasteValues
Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
Range("F2:L2").Copy destination:=Range("F" & Asor &":F" & Bsor)
For i = Asor To Bsor
Range("A" & i) = Range("A" & i - 1) + 1
Next i
End SubSzerintem a rangod miatt nem enged válaszolni...
-
poffsoft
veterán
válasz
logitechh
#35035
üzenetére
Azt nem mondtad, hogy több sor is.
Sub mm()
Dim usor As Long
Dim i As Integer
usor = Range("B" & Rows.Count).End(xlUp).Row + 1
'ide jön a "4 oszlopnyi adat" másolása, például
'range("B" & usor-1 & ":E" & usor-1).copy
'Fontos, hogy az irányított beillesztés előtt legyen Copy parancs
Range("B" & usor).PasteSpecial xlPasteValues
For i = Range("A" & Rows.Count).End(xlUp).Row to Range("B" & Rows.Count).End(xlUp).Row
Range("A" & i) = Range("A" & i - 1) + 1
Next i
End Sub -
poffsoft
veterán
válasz
poffsoft
#35032
üzenetére
Vagy egyszerűbben:
Sub iranyitott_beillesztes()
'
' iranyitott_beillesztes_ Makró
'
'
Dim usor As Long
usor = Range("A" & Rows.Count).End(xlUp).Row +1
Cells(usor, 1)=Cells(usor-1, 1)+1
Cells(usor, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Cells(2, 1), Cells(usor, 12)).Select
'
' itt jöhet a szegélyezés
'
Cells(usor, 1).Select
End Sub -
poffsoft
veterán
válasz
logitechh
#35029
üzenetére
Sub iranyitott_beillesztes()
'
' iranyitott_beillesztes_ Makró
'
'
Dim usor As Long
usor = Range("A" & Rows.Count).End(xlUp).Row +1
Cells(usor, 1)=Cells(usor-1, 1)+1
Cells(usor, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Cells(2, 1), Cells(usor, 12)).Select
'
' itt jöhet a szegélyezés
'
Cells(usor, 1).Select
End Sub -
poffsoft
veterán
-
poffsoft
veterán
válasz
RAiN91
#34393
üzenetére
mergearea tulajdonság.
[link]
gúgli 2. találat.A
B4:B11range értékének lekérdezése:Range("B4").Value
Range("B4:B11").Cells(1).Value
Range("B4:B11").Cells(1,1).Valueszemély szerint én ezt preferálom:
Range("B4").MergeArea.Cells(1,1).Value
esetleg ez:Range("B4:B11").Item(1).Value -
poffsoft
veterán
=HA(A3="";"";FKERES($A3;Munka1!$A:$ID;233;HAMIS))
Mivel ha a 4. argumentum IGAZ vagy hiányzik, csak közelítő értéket talál, nem pontos egyezést.
Amúgy a hol.van és index fv párosa elegánsabb lenne:FKERES($A3;Munka1!$A:$ID;233;HAMIS))
helyettINDEX(Munka1!HY5:HY170;HOL.VAN($A3;Munka1!A5:A170;0)) -
#34142
poffsoft
veterán
szőröscica
#34140
poffsoft
veterán
válasz
szőröscica
#34140
üzenetére
Option Explicit
Public Sub makro1()
Dim i As Integer
Dim l As Integer
Dim RowCount As Integer
Dim S1 As String
Dim S2 As String
RowCount = 10
S1 = "Submitter excl. trades"
S2 = "Trading activity_NEW"
Worksheets(S1).Select
For i = 3 To RowCount
If Not IsEmpty(Range("D" & i)) Then
l = Range("H" & Rows.Count).End(xlUp).Row + 1
Range("H" & l) = Range("J" & i)
Range("I" & l) = Sheets(S2).Range("D" & i)
End If
Next i
End Sub -
poffsoft
veterán
válasz
Fferi50
#34063
üzenetére
o.k.
Fránya makrórögzítő csak így hajlandó rögzíteni.
ráadásul a "H" még hibás is volt, csak most vettem észre:
Sub Rendez()
Dim usor As Long
Dim lusor As Long
Dim ms As Long ' max sor'
Dim sm As Long ' aktualis sor'
Dim i As Variant
Dim Ls() As String
Dim Ts As String
Dim valasz As String
Ls() = Split("B.C.D.E", ".") ' a neveket tartalmazó oszlopok'
Ts = "H" ' a szűrt lista oszlopa'
sm = 1
ms = Rows.Count
usor = Range(Ts & ms).End(xlUp).Row
If usor > 1 Then
valasz = MsgBox("Nem üres a cél """ & Ts & """ oszlop." & vbCrLf & "Folytatod?", vbYesNo, "Figyelem!")
If valasz = vbYes Then Range(Ts & "1:" & Ts & usor).Clear Else Exit Sub
End If
For Each i In Ls
usor = Range(i & ms).End(xlUp).Row
If usor > 1 Then
Range(i & "2:" & i & usor).Copy Destination:=Range(Ts & sm)
sm = sm + usor - 1
End If
Next i
'duplicate remove'
usor = Range(Ts & ms).End(xlUp).Row
Application.DisplayAlerts = False
Range(Ts & "1:" & Ts & usor).RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = True
With ActiveSheet.Sort
.SetRange Range(Ts & "1:" & Ts & usor)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range(Ts & "1").Select
End Sub -
#34062
poffsoft
veterán
lizakattila
#34061
poffsoft
veterán
válasz
lizakattila
#34061
üzenetére
parancsolj:
Sub Rendez()
Dim usor As Long
Dim lusor As Long
Dim ms As Long 'max sor'
Dim sm As Long 'aktualis sor'
Dim i As Variant
Dim Ls() As String
Dim Ts As String
Dim valasz As String
Ls() = Split("B.C.D.E", ".") ' a neveket tartalmazó oszlopok'
Ts = "H" ' a szűrt lista oszlopa'
sm = 1
ms = Rows.Count
usor = Range(Ts & ms).End(xlUp).Row
If usor > 1 Then
valasz = MsgBox("Nem üres a cél """ & Ts & """ oszlop." & vbCrLf & "Folytatod?", vbYesNo, "Figyelem!")
If valasz = vbYes Then Range(Ts & "1:" & Ts & usor).Clear Else Exit Sub
End If
For Each i In Ls
usor = Range(i & ms).End(xlUp).Row
If usor > 1 Then
Range(i & "2:" & i & usor).Select
Application.CutCopyMode = False
Selection.Copy
Range("H" & sm).Select
ActiveSheet.Paste
sm = sm + usor - 1
End If
Next i
'duplikációk eltávolítása, abc sorrend'
usor = Range(Ts & ms).End(xlUp).Row
Application.DisplayAlerts = False
Range(Ts & "1:" & Ts & usor).RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = True
With ActiveSheet.Sort
.SetRange Range(Ts & "1:" & Ts & usor)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range(Ts & "1").Select
End Sub -
poffsoft
veterán
válasz
Fferi50
#33964
üzenetére
Én értem.
Nem biztos, hogy nordican is értette az uniont.Szóval, ha csak azokat a
cellákat figyeled, amik az A oszlopban (A:A) vannak, és a B1:E100 tartományban, meg a 23. sort:If Not Intersect(Target, Union(Range("A:A"), Range("B1:E100"), Range("23:23"))) Is Nothing Then -
poffsoft
veterán
válasz
nordican
#33959
üzenetére
nem is .
ez egy lap eseményhez rendelt makró.
vagyis, minden alkalommal, ha a munkalapon megváltoztatod valamelyik cella tartalmát, automatikusan lefut.
Mondjuk én a target.rows.autofitet használnám, vagyis annak a sornak a magasságát állítani, amelyikben éppen szerkesztettél.
ha ugyanezen a címen kell igazítanod a másik lapon, akkor még beszúrnám:
sheets("Munka2").range(target.address).rows.autofit -
poffsoft
veterán
válasz
nordican
#33903
üzenetére
Liste=Activesheet.NameGondolom, le lehet kérdezni a kijelölt sheetek neveit is.
Ha csak az aktivesheet kell, akkor pl:
Sub Makro1()
Dim rng As Range
Dim c As Range
Set rng = Range("A1:F100")
For Each c In rng
With c.Interior
If .ColorIndex = 6 Then
.ColorIndex = None
.Pattern = xlNone
End If
End With
Next c
End Sub -
poffsoft
veterán
válasz
nordican
#33891
üzenetére
Én ezt barkácsoltam:
Sub Makro1()
Dim list() As String
Dim liste As String
Dim i As Integer
Dim c As Range
Dim rng As Range
liste = "Munka1,Munka2,Munka3" 'a munkalapok nevei, ahol keresni kell, vesszővel elválasztva
list() = Split(liste, ",")
For i = 0 To UBound(list)
Set rng = Sheets(list(i)).Range("A1:F100")
For Each c In rng
With c.Interior
If .ColorIndex = 6 Then
.ColorIndex = None
.Pattern = xlNone
End If
End With
Next c
Next i
End Sub -
poffsoft
veterán
válasz
nordican
#33891
üzenetére
Egy bizonyos lapon lévő rangera a hivatkozás:
Sheets(1).Range("A1", "F100").Select
vagySheets("Munka1").Range("A1", "F100").Selecta sárga cellák szűrése (feltéve, hogy a colorindex=6 sárgáról van szó):
With Selection.Interior
If .ColorIndex = 5 Then
.ColorIndex = None
.Pattern = xlNone
End If
End With -
poffsoft
veterán
válasz
nordican
#33812
üzenetére
1) van egy modulod (Module1) a public function name()-vel
2) a munkalapodon (Munka1) kell (VBA szerkesztőben duplaklikk) pl. az activate eseményhez rendelned az értékadást:Private Sub Worksheet_Activate()
ActiveSheet.PageSetup.CenterHeader = Module1.name()
End SubA linkre tudtommal nincsen, én a szöveg utáni cellába szoktam egy [Link] szöveg mögé szúrni a linket.
-
poffsoft
veterán
válasz
Fferi50
#33795
üzenetére
Nekem eszembe sem jutott volna.
Ezt sikerült összehoznom végül:
Public Function STR_SPLIT(ByVal str As String, ByVal sep As String, Optional ByVal n As Integer = 0)
Dim V() As String
Dim num As Integer
V = Split(str, sep)
num = UBound(V)
If num < n Then STR_SPLIT = "#SOK": Exit Function
If n = 0 Then STR_SPLIT = num Else STR_SPLIT = V(n - 1)
End Functiona képlet pedig:
=STR_SPLIT(CELLA("filenév");"\";STR_SPLIT(CELLA("filenév");"\"))ahol:
=STR_SPLIT(CELLA("filenév");"\")
megadja, hány darabból áll a mappanév,=STR_SPLIT(CELLA("filenév");"\";2)
megadja, hogy a 2. mappa nevét.
-
-
poffsoft
veterán
válasz
nordican
#33776
üzenetére
munkalapokról beszélsz, nem munkafüzetekről, ugye?
Jó a képleted (&=összefűz), csak még stringként be kell szúrnod a többit:
=Munkafüzet1!A1&", "&Munkafüzet2!B3&"."Ha speciális karaktert (pl. sortörés) is akarsz bele:
=Munkafüzet1!A1&", "&KARAKTER(10)&Munkafüzet2!B3&"." -
poffsoft
veterán
válasz
Fferi50
#33773
üzenetére
Megnyugodtam. Eddig féltem, megint nekem vannak szövegértési nehézségeim.
Kategorikusan havi adatok összevetéséről beszél a kolléga.
Szerintem még mindig az a gondja, hogy hogyan állapítsa meg az adott hónap napjainak számát (vagyis az átlag, median, módusz, stb.) számításához mekkora range-t kell kijelölnie.
Gondolom, perpillanat csak fix 31 cellás vektorokkal tudja a képleteket beírni...
De nem okoskodom tovább, megvárjuk a válaszát -
Új hozzászólás Aktív témák
Hirdetés
- 45 wattos vezeték nélküli töltés jön az új iPhone-ba
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- LEGO klub
- Házimozi belépő szinten
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- HiFi műszaki szemmel - sztereó hangrendszerek
- Le Mans Ultimate
- NBA és kosárlabda topic
- Lakáshitel, lakásvásárlás
- Teljes verziós játékok letöltése ingyen
- További aktív témák...
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Eladó Steam kulcsok kedvező áron!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Azonnali készpénzes nVidia RTX 3000 sorozat videokártya felvásárlás személyesen / csomagküldéssel
- Készpénzes számítógép PC félkonfig alkatrész hardver felvásárlás személyesen / postával korrekt áron
- Telefon felvásárlás!! iPhone 16/iPhone 16 Plus/iPhone 16 Pro/iPhone 16 Pro Max
- ÁRGARANCIA! Épített KomPhone i5 14600KF 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5800X 16/32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged