- Netfone
- Fotók, videók mobillal
- iPhone topik
- Android alkalmazások - szoftver kibeszélő topik
- Redmi Note 13 Pro 5G - nem százas, kétszázas!
- Xiaomi 15 - kicsi telefon nagy energiával
- Samsung Galaxy Watch4 és Watch4 Classic - próbawearzió
- Karaktere biztos lesz az első Nothing fejhallgatónak
- Honor 400 Pro - gép a képben
- Apple iPhone 16 Pro - rutinvizsga
-
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
-
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* 1
Má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
- CURVE - "All your cards in one." Minden bankkártyád egyben.
- Kevesebb dolgozó kell az Amazonnak, AI veszi át a rutinfeladatokat
- Kínai és egyéb olcsó órák topikja
- Túra és kirándulás topic
- Milyen POS terminál szolgáltatót válasszon egy mikro- vagy kisvállalkozás?
- AMD vs. INTEL vs. NVIDIA
- Amazon
- A fociról könnyedén, egy baráti társaságban
- BestBuy topik
- btz: Internet fejlesztés országosan!
- További aktív témák...
- Sea of Thieves Premium Edition és Egyéb Játékkulcsok.
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Assassin's Creed Shadows Collector's Edition PC
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Xbox Ultimate előfizetések
- BESZÁMÍTÁS! Gigabyte A620M R5 7600 32GB DDR4 512GB SSD RTX 5060 Ti 16GB Zalman i3 NEO Enermax 650W
- REFURBISHED - HP USB-C Universal Dock G1 docking station (DisplayLink)
- AKCIÓ! AMD Ryzen 5 2600 6 mag 12 szál processzor garanciával hibátlan működéssel
- Laptop felvásárlás , egy darab, több darab, új , használt ! Korrekt áron !
Állásajánlatok
Cég: CAMERA-PRO Hungary Kft
Város: Budapest
Cég: Promenade Publishing House Kft.
Város: Budapest