-
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
-
Nowitzki
csendes tag
Sziasztok!
Milyen paramétert kell megadnom a print # használatakor hogy a karakter kódolás stimmeljen? Megcsinálja az adatexportot, de a txt fájlban a szöveg tele van kérdőjelekkel az ékezetes karakterek helyén, pedig a txt fájl alapból utf-8-ban van mentve.
Tudnátok segíteni nekem ebben?Köszönöm!
-
Nowitzki
csendes tag
Sziasztok!
Egy kis segítségre lenne szükségem!
A "Sheet1"-en a "D" oszlopban vannak a cikkek, a "K" oszlopban vannak a mennyiségek, az "L" oszlopban pedig a dátum.
Egy csikkhez és egy dátumhoz minden sorban szerepel ugyanaz a mennyiség is.
A többi oszlopban különböző értékek vannak így a duplikációkat nem lehet törölni.
A "Sheet2"-n a "B34" és a "C34" cellában meg van adva 2 dátum.
Milyen képlettel lehetne kiszámoltani, hogy a "Sheet2"-n a "B34" és a "C34" cellában megadott dátumok között szummázza cikk szerint a mennyiségeket, de egy cikkhez és egy dátumhoz csak egyszer számolja a mennyiséget?Köszönöm!
-
-
-
Nowitzki
csendes tag
válasz
nobiand
#31329
üzenetére
Vagy pedig ami sokkal egyszerűbb, és minden esetben működik például ez
Sub PONT()
For Each c In Columns("A").Cells 'Itt add meg az érintett tartományt
If InStr(c.Value, ".") > 0 Then c.Value = Left(c.Value, InStr(c.Value, ".") - 1)
Next c
End Sub
Ez pédául az "A" oszlop összes cellájában levágja a pont utáni részt. -
Nowitzki
csendes tag
válasz
tgumis
#31203
üzenetére
Próbáld meg ezt:
Sub fejlec_formazas()
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
With ws
.Activate
.Unprotect Password:="Lufi09"
With ActiveWindow
.FreezePanes = False
Range("A10").Select
.FreezePanes = True
End With
.Range("I1:I3").Interior.Color = RGB(204, 192, 218)
With .Range("B1:D3,B8:D158,I8:J158,M8:N158,P8:P158,S8:V158,Y8:Y158")
.Locked = False
.FormulaHidden = False
End With
If .AutoFilterMode Then .Cells.AutoFilter
.Range("A6:J6").AutoFilter
' kódolás
.Protect Password:="Lufi09", _
UserInterfaceOnly:=True, _
AllowFormattingColumns:=True, _
AllowFiltering:=True
.EnableSelection = xlNoRestrictions
End With
Next ws
Application.ScreenUpdating = True
End Sub -
Nowitzki
csendes tag
válasz
Kalandor
#31181
üzenetére
Mindenféle utómunka nélkül szerintem sem lehetséges szétválasztani a szöveget (csak ha tabulátorral vannak elválasztva az egyes értékek). Szerintem a legegyszerűbb ha a fenti makrót bemásolod a "PERSONAL.XLSB" fájlba és akkor az összes excel fájlban működni fog egy klikkre.
-
Nowitzki
csendes tag
válasz
Kalandor
#31179
üzenetére
Importálás nélkül tabulátorral kell elválasztva lenniük az értékeknek hogy másolás-beillesztéskor külön cellába kerüljenek az értékek. Minden más esetben csak importálással működik, vagy beillesztés után "text to columns", mindkettőre lehet makrót írni. Például ha ezzel "¿" legyen elálasztva akkor csak bemásolod az "A1" cellába a "¿"-vel elválasztott értékeket (pl.: adat1¿adat2¿adat3¿adat4¿adat5) és futtatod ezt:
Sub Macro1()
Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Other:=True, OtherChar:="¿"
End Sub
akkor szétszedi cellákba. -
#31170
Nowitzki
csendes tag
PowerBuldog
#31169
Nowitzki
csendes tag
válasz
PowerBuldog
#31169
üzenetére
Vagy ha a részleteket is ki akarod íratni akkor:
Sub pizza()
sor = 1
For pizza1 = 1 To 45
For pizza2 = 1 To 45
Cells(sor, "B") = "pizza" & pizza1 & "+" & "pizza" & pizza2 'pizzák sorszámai
Cells(sor, "C") = Cells(pizza1, "A") & "+" & Cells(pizza2, "A") ' pizzák árai
Cells(sor, "D") = Cells(pizza1, "A") + Cells(pizza2, "A") 'pizzák összege
Cells(sor, "E") = "=" & Cells(pizza1, "A").Address & "+" & Cells(pizza2, "A").Address 'pizzák összege képlettel
sor = sor + 1
Next pizza2
Next pizza1
End Sub -
#31168
Nowitzki
csendes tag
PowerBuldog
#31167
Nowitzki
csendes tag
válasz
PowerBuldog
#31167
üzenetére
Ha az "A" oszlopban vannak egymás alatt felsorolva a pizzák árai, akkor működik. Ezért kérdeztem, hogy hol vannak neked megadva az egyes pizzák árai.
-
#31166
Nowitzki
csendes tag
PowerBuldog
#31165
Nowitzki
csendes tag
válasz
PowerBuldog
#31165
üzenetére
Hol vannak megadva a pizzák árai?
Tegyük fel az "A" oszlopban vannak egymás alatt felsorolva az egyes pizzák árai. Akkor mondjuk ez működhet:Sub pizza()
sor = 1
For pizza1 = 1 To 45
For pizza2 = 1 To 45
Cells(sor, "B") = "pizza" & pizza1 & "+" & "pizza" & pizza2
Cells(sor, "C") = Cells(pizza1, "A") + Cells(pizza2, "A")
sor = sor + 1
Next pizza2
Next pizza1
End Sub -
Nowitzki
csendes tag
válasz
Declare
#31162
üzenetére
Ez hozzáírja a fájlnévhez a mentés dátumát (év, hó, nap, óra, perc).
Sub ActiveSheetExportToPdf1()
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste_" & Format(Now, "yyyymmdd_hhnn") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End SubEz pedig hozzáad egy növekményes azonosítót a fájlnévhez ha az már létezik.
Sub ActiveSheetExportToPdf2()
cntr = ""
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf") = "" Then GoTo xprt
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf") <> "" Then
cntr = 1
Do Until Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf") = ""
cntr = cntr + 1
Loop
End If
xprt:
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & cntr & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub -
Nowitzki
csendes tag
válasz
Declare
#31160
üzenetére
Szia,
Próbáld meg ezt:
Sub ActiveSheetExportToPdf()
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Laserteileliste" & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub -
-
Nowitzki
csendes tag
Sziasztok,
Egy kis segítséget szeretnék kérni.
Van egy munkafüzet jó pár ezer sorral. Az adatok alapesetben hetes csoportokban vannak (101-107), de néha olyan adatokat is regisztrál a gép aminek nincs meg mind a hét sora. Ezeket a sorokat szeretném automatikusan törölni egy makróval. Írtam is rá egyet de nem úgy működik ahogy szeretném. Tudnátok segíteni nekem ebben?
Sub DeletingUnnecessaryRows()
For i = 2 To ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Rows.Count, 1).End(xlUp).Row
If Cells(i + 1, 1) - Cells(i, 1) <> 1 And Cells(i + 1, 1) - Cells(i, 1) <> -6 Then
Rows(i).EntireRow.Delete
End If
Next
EndElőre is nagyon szépen köszönöm!
Új hozzászólás Aktív témák
- Lítium-ion/Li-ion akkumulátorok
- Fejhallgató erősítő és DAC topik
- BestBuy topik
- AMD Ryzen 9 / 7 / 5 / 3 5***(X) "Zen 3" (AM4)
- OLED monitor topic
- Apple MacBook
- MWC 2026: Na, fussunk vele még egy kört!
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- iPhone topik
- Mibe tegyem a megtakarításaimat?
- További aktív témák...
- Csere-Beszámítás! Apple Macbook Pro 2013 vége! 512GB SSD, I7, 16GB DDR3, Intel Iris Pro! Olvass!
- AKCIÓS ! MacBook Pro 16" M1 Pro 16GB RAM 512GB SSD! 1 év garancia!
- GYÖNYÖRŰ iPhone XR 128GB Red-1 ÉV GARANCIA - Kártyafüggetlen, MS3984, 100% Akkumulátor
- ASUS ROG Strix OLED XG27AQDMGR (1440p,240Hz,TrueBlack Glossy,G-Sync) 3év garanciával!
- Apple iPhone 15 256GB,Átlagos,Adatkabel,12 hónap garanciával
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest