Hirdetés
- Graphics: Telefonvásárlási kálváriám....avagy clickbait cím: Horror a hardveraprón
- Luck Dragon: Asszociációs játék. :)
- Gurulunk, WAZE?!
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Hieronymus: Az igaz barátság kezdete
- ricsi99: 6. Genes alaplap tündöklése kontra MS/Zintel korlátozásai
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- Doky586: SecureBoot kulcsok frissítése (2026 nyara)
- sziku69: Fűzzük össze a szavakat :)
- Parci: Milyen mosógépet vegyek?
-
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
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 -
Fferi50
Topikgazda
válasz
lizakattila
#34059
üzenetére
Szia!
A H oszlopba átmásolod a neveket minden oszlopból egymás alá. Ezután kijelölöd az oszlopot, adatok - ismétlődések eltávolítása.
Üdv.
-
Delila_1
veterán
válasz
lizakattila
#32314
üzenetére
Nagyszerű!
-
Delila_1
veterán
válasz
lizakattila
#32310
üzenetére
A beolvasás is lehet egyszerűbb, a reg1 ComboBox Change eseményéhez rendelve.
Private Sub reg1_Change()
Dim sor, oszlop As Integer
With Sheets("Sheet2")
sor = Application.Match(reg1, .Columns(1), 0)
For oszlop = 2 To 11
Controls("reg" & oszlop) = .Cells(sor, oszlop)
Next
End With
End SubA gomb esetében marad az az 1 sor, amit írtam (+ elé a sor kikeresése a MATCH függvénnyel). Esetleg még a végére a form bezárása:
Unload Me -
Delila_1
veterán
válasz
lizakattila
#32310
üzenetére
Akkor a feltöltés Ok, csak a levonás kell.
Sheets("Sheet2").Cells(sor, 5) = Sheets("Sheet2").Cells(sor, 5) - reg5* 1Már ha a reg5 valóban az E oszlop megfelelője.
Azért a feltöltésnél alkalmazhatnád, amit a sor kikereséséről írtam előbb. Ugyanannak a sornak az n-edik tagját viszed a textboxokba, ezért elég lenne 1 keresés.
-
Delila_1
veterán
válasz
lizakattila
#32306
üzenetére
Figyelmesebben elolvastam a kérdést.
Ha jól értem, azt a sort keresed, amelyikben az On-Hand kivételével minden adat megegyezik a most bevittekkel, és a jelenlegi On-Hand értéket akarod levonni a megtalált sor E oszlopának az értékéből. Így gondolod?
-
Delila_1
veterán
válasz
lizakattila
#32306
üzenetére
Az Item-nek már eleve a textbox helyett comboboxot érdemes tenni, ahol a RowSource tulajdonságba beírod a tartományt, ahonnan az értékeket veszi, pl. Sheet2!A1:A200.
Elég egyszer kikeresni a sort, aminek az értékeihez hozzá akarod adni a UserFormon megadott adatokat.
Private Sub cmdClose_Click()
Dim sor
'Ellenőrzés
If reg1 = "" Or reg2 = "" Or reg3 = "" Or reg4 = "" Then
MsgBox "Hiányos kitöltés", vbExclamation
Exit Sub
End If
With Sheets("Sheet2")
sor = Application.Match(reg1, .Range("A:A"), 0)
.Cells(sor, 2) = .Cells(sor, 2) + reg2 * 1
.Cells(sor, 3) = .Cells(sor, 3) + reg3 * 1
.Cells(sor, 4) = .Cells(sor, 4) + reg4 * 1
End With
End SubA szorzás azért kell, hogy a textboxban szereplő szöveget (szöveg, azért text) számmá alakítsuk.
-
Delila_1
veterán
válasz
lizakattila
#31273
üzenetére
Írd be egy oszlopba az európai országokat. A feltételes formázásnál FKERES, vagy DARABTELI függvénnyel hivatkozz erre az oszlopra. =darabteli(országnevek_tartománya;A1)>0
-
bsh
addikt
válasz
lizakattila
#29963
üzenetére
ilyesmi? biztos van egyszerűbb is.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each Item In Target.Cells
If Item.Column = 15 Then
If Item = "" Then
Cells(Item.Row, 1) = ""
Else
Cells(Item.Row, 1) = Now()
End If
End If
Next
Application.EnableEvents = True
End Sub -
Delila_1
veterán
válasz
lizakattila
#29963
üzenetére
Range(Target.Address).Offset(0, -14) = Now()
-
Delila_1
veterán
válasz
lizakattila
#29714
üzenetére
Az
If Target.Column <> 2 Then Exit Sub
sorban a 2 helyett írj 15-öt, és a
Target.Offset(0, -1).Value = Now()
sorban a -1 helyett -14-et.
-
Delila_1
veterán
válasz
lizakattila
#24796
üzenetére
Nincs mit, elvégre földim vagy.

-
Delila_1
veterán
válasz
lizakattila
#24793
üzenetére
Az A oszlop feltételes formázásának a képlete
=A1/B1<>INT(A1/B1)
-
Delila_1
veterán
válasz
lizakattila
#13995
üzenetére
Készíts kimutatást. A SOR-hoz tedd az oszlopod címét, és ugyanazt az ADAT-hoz is (2003-as verzió), ahol a darabszámot kéred, és máris kész.
2007-es verzióban a címet a SORCÍMKÉK-hez és az ÉRTÉKEK-hez tedd.
-
Sweet Lou 6
addikt
válasz
lizakattila
#13993
üzenetére
Új hozzászólás Aktív témák
Hirdetés
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Realme GT 2 - aláírjuk
- PlayStation 5
- Samsung kuponkunyeráló
- 3D nyomtatás
- Forza sorozat (Horizon/Motorsport)
- Eredeti játékok OFF topik
- Graphics: Telefonvásárlási kálváriám....avagy clickbait cím: Horror a hardveraprón
- Elektromos autók - motorok
- Milyen széket vegyek?
- További aktív témák...
- Game Pass Ultimate előfizetések 3 - 36 hónapig azonnali kézbesítéssel! 13 hónap ultimate - 50.000 ft
- MS SQL Server 2016, 2017, 2019
- 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!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Samsung 990 PRO 4TB Gen4 NVMe SSD!
- BESZÁMÍTÁS! ASUS H610M i5 12400F 16GB DDR4 1TB SSD RTX 3050 6GB Endorfy Signum 300 TG MSI 650W
- Laptop felvásárlás , egy darab, több darab, új , használt ! Korrekt áron !
- Samsung Enterprise PM893 1,92TB/ SATA 2,5" SSD- 6db/ számla-garancia
- ÁRGARANCIA!Épített KomPhone Ryzen 5 9600X 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50