Hirdetés
- Yettel topik
- Apple iPhone 17 Pro Max – fennsík
- Fotók, videók mobillal
- Amazfit Bip 6 - jót olcsón
- Visszatérnek a Samsung tervezte CPU-magok és GPU az Exynos 2800-ban?
- Amazfit T-Rex 3 Pro – világítós dínó
- Milyen okostelefont vegyek?
- Okosóra és okoskiegészítő topik
- Vivo X200 Pro - a kétszázát!
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
-
Mobilarena
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
-
Pakliman
tag
válasz
Norbika1493
#46735
üzenetére
Szia!
Pl. az összefoglaló utolsó sora...
-
lappy
őstag
válasz
Norbika1493
#46395
üzenetére
https://www.contextures.com/xluserform02.html
Akár ez is jó lehet -
tgumis
tag
válasz
Norbika1493
#45649
üzenetére
-
lappy
őstag
válasz
Norbika1493
#45649
üzenetére
Fkeres
-
Fferi50
Topikgazda
válasz
Norbika1493
#45285
üzenetére
Szia!
Úgy nem műxik. Csináld úgy, ahogyan Delila mutatta.
Üdv.
Ps. Érdemes az FKERES helpjét hozzáolvasni. -
Delila_1
veterán
válasz
Norbika1493
#45285
üzenetére
Szívesen.
Az FKERES függvény a közelítő érték keresésekor úgy működik, ahogy leírtam. -
Delila_1
veterán
válasz
Norbika1493
#45281
üzenetére
-
Pakliman
tag
válasz
Norbika1493
#45186
üzenetére
Egy pl...
Ez egy meglévő táblázatban halad végig és bizonyos cellák értéke alapján színez bizonyos számokat is.
Készít egy táblázatot az így létrejótt listából és elküldi a megadott címzetteknek:Public Enum OlBodyFormat
olFormatUnspecified = 0
olFormatPlain = 1
olFormatHTML = 2
olFormatRichText = 3
End Enum
Private Function TableDataColor(strIn As String, Optional color As String = "") As String
If color = "" Then
TableDataColor = strIn
Else
TableDataColor = "<FONT COLOR=" & color & ">" & strIn & "</FONT>"
End If
End Function
Private Function Table(strIn As String, Optional lBorder As Long = 0) As String
Dim sBorder As String
If lBorder = 0 Then
sBorder = ""
Else
sBorder = " border=" & lBorder
End If
Table = "<TABLE" & sBorder & ">" & strIn & "</TABLE>"
End Function
Private Function TableData(strIn As String, Optional alignment As String = "") As String
TableData = "<TD nowrap align=" & alignment & ">" & strIn & "</TD>"
End Function
Private Function TableRow(strIn As String) As String
TableRow = "<TR>" & strIn & "</TR>"
End Function
Public Sub Email_Humányügyre()
Dim sSzöveg1 As String: sSzöveg1 = "Kedves Lányok!" & "<br /><br />"
Dim sSzöveg2 As String: sSzöveg2 = "Szíves hasznosításra..." & "<br /><br />" & _
"Üdv," & "<br /><br />"
Dim OutApp As Object
Dim OutMail As Object
Dim strFej As String
Dim strTB As String
Dim sDátum As String: sDátum = Format(Format(Range("Z1"), "0000"".""00"".""00"), "yyyy. mmmm")
Dim sTárgy As String: sTárgy = "Külsősök teljesítései " & sDátum
Dim lAktSor As Long
Dim lÚjSor As Long
Dim szín As String
strFej = TableRow( _
TableData("HR") & _
TableData("Név") & _
TableData("Összes óra") _
)
For lAktSor = 3 To Cells.Rows.Count 'Az utolsó sort célszerű először meghatározni...
If IsEmpty(Cells(lAktSor, 1)) Then Exit For
If Cells(lAktSor, 15) = "Külsős" Then
Select Case Cells(lAktSor, 11)
Case 60 To 79.9
szín = "blue"
Case Is > 80
szín = "red"
Case Else
szín = ""
End Select
strTB = strTB & _
TableRow( _
TableData(Cells(lAktSor, 1)) & _
TableData(Cells(lAktSor, 2)) & _
TableData( _
TableDataColor( _
Format(Cells(lAktSor, 11), "0.0"), _
szín _
), _
"right" _
) _
)
End If
Next lAktSor
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Humánügyek"
.CC = "hum1@hum.hu; hum2@hum.hu"
.BCC = ""
.Subject = sTárgy
.BodyFormat = 2 'olFormatHTML
.HTMLBody = sSzöveg1 & _
Table( _
"<Caption>Külsős órák</Caption>" & _
strFej & _
strTB _
, 1) & "<br /><br />" & _
sSzöveg2
.Display ' vagy elküldéshez .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub -
lappy
őstag
válasz
Norbika1493
#45131
üzenetére
Üres függvény
-
Delila_1
veterán
válasz
Norbika1493
#45129
üzenetére
-
Delila_1
veterán
válasz
Norbika1493
#45127
üzenetére
Az összesítésnél [óó]:pp:mm formát kell alkalmaznod.
-
Bobrooney
senior tag
válasz
Norbika1493
#44776
üzenetére
-
lappy
őstag
válasz
Norbika1493
#44776
üzenetére
Szumha függvényt nézd meg inkább.
-
Delila_1
veterán
válasz
Norbika1493
#44776
üzenetére
Nem másik táblázatot, hanem kimutatást kell készítened az eredeti táblázat adataiból.
-
Fferi50
Topikgazda
válasz
Norbika1493
#44767
üzenetére
Szia!
Makrórögzítést próbáltad?
Üdv. -
Fferi50
Topikgazda
válasz
Norbika1493
#44764
üzenetére
-
Delila_1
veterán
válasz
Norbika1493
#44762
üzenetére
Az A füzetben szűrd az adatokat úgy, hogy az üres sorok ne jelenjenek meg. Másold a látható sorokat, és illeszd be a B füzetbe.
-
Fferi50
Topikgazda
válasz
Norbika1493
#42312
üzenetére
Szia!
Két lehetőség - makró nélkül - "félautomatikus"
1. CTRL+0 beírja az adott cellába a mai dátumot. Ez nem frissül tovább
2. Ma() függvény előre végighúzva az oszlopon. Amikor beírod a terméket, akkor az adott soron másolás - irányított beillesztés értéket.
Egyébként valóban makró.
Üdv. -
Pakliman
tag
válasz
Norbika1493
#42312
üzenetére
Szia!
Ha jól értelmezem a dolgot, akkor az csak VBA-val oldható meg, mert a függvény (MOST()) jövő héten is frissülni fog és az akkori értéket mutatja majd.
Markóval:
A munkalap Change eseményébe kell beírni, hogy ha az adott oszlopban változik egy cella értéke, akkor a meghatározott cellába írja be a dátumot.Private Sub Worksheet_Change(ByVal Target As Range)
'Feltételezzük: Dátum "A" (1.) oszlop, Termék "D" (4.) oszlop
If Target.Column = 4 Then Cells(Target.Row, 1) = Date
End Sub
Új hozzászólás Aktív témák
- Proxmox VE
- Yettel topik
- Székesfehérvár és környéke adok-veszek-beszélgetek
- Sütés, főzés és konyhai praktikák
- Apple iPhone 17 Pro Max – fennsík
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Fotók, videók mobillal
- Amazfit Bip 6 - jót olcsón
- exHWSW - Értünk mindenhez IS
- AMD Navi Radeon™ RX 7xxx sorozat
- További aktív témák...
- Eladó Steam kulcsok kedvező áron!
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Apple iPhone 11 128 GB Lila 1 év Garancia Beszámítás Házhozszállítás
- HIBÁTLAN iPhone 15 Pro Max 256GB Blue Titanium -1 ÉV GARANCIA -Kártyafüggetlen,MS4120
- Eladó XpertVision GT 1030 Silent 2GB videokártya
- HIBÁTLAN iPhone 12 Mini 128GB Black-1 ÉV GARANCIA - Kártyafüggetlen, MS3633
- ÁRGARANCIA!Épített KomPhone i5 14600KF 32/64GB RAM RX 9070 16GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest




Fferi50

