-
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
- Xiaomi 17 Ultra - jó az optikája
- SUSE Linux
- Kezdő fotósok digitális fényképei
- Windows 11
- Xiaomi 15T Pro - a téma nincs lezárva
- Mibe tegyem a megtakarításaimat?
- Ilyen olcsó sem volt még egy Apple notebook
- Viccrovat
- Kertészet, mezőgazdaság topik
- Teljesen M5 SoC-családra vált az Apple Macbook Air és Pro
- További aktív témák...
- Apple iPhone 13 128GB, Kártyafüggetlen, 1 Év Garanciával
- ÁRGARANCIA! Épített KomPhone R7 5700X 16/32/64GB RAM RX 9060 XT 16GB GAMER PC termékbeszámítással
- Beszámítás! Apple Mac Mini 2020 M1 8GB 512GB számítógép garanciával, hibátlan működéssel
- Akció! Apple iMac 19.2 i5-8500 Radeon Pro 560X 4GB 16GB 256GB SSD 21.5" 4K Retina
- új akku Ár/ÉRTÉK BAJNOK! Dell Latitude 5330 i3-1215U 6magos! - 16GB 512GB 13.3" FHD 1 év garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest