- Asztrofotózás
- Melyik tápegységet vegyem?
- Vezetékes FEJhallgatók
- Párduc a gépben: teszten az ASUS ExpertBook Ultra
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- AMD Ryzen 9 / 7 / 5 / 3 5***(X) "Zen 3" (AM4)
- Apple MacBook
- Milyen HASZNÁLT notebookot vegyek?
- Plazma TV topic
- AMD K6-III, és minden ami RETRO - Oldschool tuning
-
PROHARDVER!
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
-
Delila_1
veterán
válasz
#02644736
#20949
üzenetére
Az A oszlop formátuma legyen Normál"/XY", a K-é pedig szöveg.
A makróban az A oszlopba írandó adatot számként mentem (TextBox1*1), a többit szövegként. A textbox, mint a neve is mutatja, szöveges értéket ad alapból. Ha számként akarod menteni valamelyik adatot, szoroznod kell a felíráskor 1-gyel.
10 db textboxba viszem be az adatokat a formon (A:J oszlop), a K oszlop adatát a TextBox1 értéke adja.
Private Sub CommandButton1_Click()
Dim sor As Long, usor As Long, kezd As Long, WF As WorksheetFunction, f As Boolean
Set WF = Application.WorksheetFunction
f = False
Sheets("Munka1").Activate
If WF.CountIf(Columns(1), TextBox1 * 1) > 0 Then
kezd = WF.Match(TextBox1 * 1, Columns(1), 0) + 1
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = kezd To usor
Cells(sor, "A") = Cells(sor, "A") + 1
Cells(sor, "K") = Cells(sor, "A") & "/" & Year(Date)
Next
f = True
Else
usor = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
'Adatbevitel a Munka1 lapra
If f Then
usor = usor + 1
Range("A" & usor) = TextBox1 * 1 + 1
Else
Range("A" & usor) = TextBox1 * 1
End If
Range("B" & usor) = TextBox2
Range("C" & usor) = TextBox3
Range("D" & usor) = TextBox4
Range("E" & usor) = TextBox5
Range("F" & usor) = TextBox6
Range("G" & usor) = TextBox7
Range("H" & usor) = TextBox8
Range("I" & usor) = TextBox9
Range("J" & usor) = TextBox10
If f Then
Range("K" & usor) = TextBox1 + 1 & "/" & Year(Date)
Else
Range("K" & usor) = TextBox1 & "/" & Year(Date)
End If
'Rendezés
usor = Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Munka1").Sort
.SetRange Range("A1:K" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End SubSzerk.: beteheted a végére a textboxok kiürítését.
Új hozzászólás Aktív témák
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- Vicces képek
- Diablo IV
- Asztrofotózás
- Kész rémálom lesz Linuxot használni jövőre az USA egyes államaiban
- Kerékpárosok, bringások ide!
- Parkside szerszám kibeszélő
- Hivatalos a Poco X8 Pro Max gigantikus akkukapacitása
- Macrodroid
- További aktív témák...
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- LG 32U990A-S / 32" Nano IPS Black / 6K UHD 6144x3456 / 21 Megapixel 224 PPI / Adobe RGB 99%
- HP Victus 16 i5-11400H 16 GB RAM 512SSD RTX 3050 4 GB FHD 144Hz
- HIBÁTLAN iPhone 12 Pro Max 128GB Pacific Blue-1 ÉV GARANCIA - Kártyafüggetlen, MS4517, 100% Akksi
- iPhone 13 128GB 100% Green (1év Garancia) - ÚJ EREDETI AKKUMULÁTOR - AKCIÓ
- Dell Precision 3571 i7-12700H 32GB 1000GB FHD RTX T600 4GB 1 év teljeskörű garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
