-
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
-
PistiSan
addikt
válasz
Mittu88
#21868
üzenetére
Olyan 300 oszlopom van, kb 80-100 cellányi tartalommal.
Az oszlopon belül van jó néhány cella ami üres, ezért az CTRL+SHIFT Nyil problémás.Rögzítettem egy excel makrót, így néz most ki.
Sub Makró7()
'
' Makró7 Makró
'
'
Columns("P:P").Select
ActiveSheet.Range("$P$1:$P$101").RemoveDuplicates Columns:=1, Header:=xlNo
End SubHa átírom a "P" oszlopot mondjuk Q-ra, akkor szépen lefut ott is, de ez elég macerás, azt gondolnám hogy valami módon lehet egy változót megadni, ami mondjuk "LH"-ig megcsinálja ezt helyettem.
Tök jó volna, ha több oszlopot kijelölve is eltávolítaná az ismétlődéseket, de sajnos nem teszi.
-
Mittu88
senior tag
válasz
Mittu88
#21782
üzenetére
Egy ilyennel nagyjából meg lehet, de hogy klikkelésre dobja a sorrendet, azt nem tudom hogy lehet makró nélkül. Ez perpill. akármilyen cellamódosítás hatására újragenerálja a véletlen számokat, kivéve, ha ki van véve excelből az automatikus újraszámolás (99,9%-nál nincs kivéve).
-
Delila_1
veterán
válasz
Mittu88
#20049
üzenetére
Másik megoldás, ahol a ciklust elfelejthetjük:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim WF As WorksheetFunction
Set WF = Application.WorksheetFunction
Sheets("Munka1").Activate
If WF.CountA(Range("B12:B50")) < 39 Then
MsgBox "Adatok hiányoznak a B12:B50 tartományból", vbOKOnly + vbExclamation
Cancel = True
Else
If WF.CountA(Range("D12:D50")) < 39 Then
MsgBox "Ejnye-bejnye!", vbOKOnly + vbExclamation
Cancel = True
Exit Sub
End If
End If
End Sub -
Mutt
senior tag
válasz
Mittu88
#20049
üzenetére
Hello,
Ezt használd az eseményben
Dim cbHiba As Boolean
Dim rngAdatsor As Range
Dim cella As Range
Set rngAdatsor = Worksheets("Igénylő").Range("B12:B15")
cbHiba = False
For Each cella In rngAdatsor
'ha a cella nem üres, akkor 4-el jobbra tőle is megnézzük a cellát
If Len(cella) > 0 Then
If Len(cella.Offset(, 4)) = 0 Then
'ha nincs kitöltve, akkor kilépünk
cbHiba = True
Exit For
End If
End If
Next cella
If cbHiba Then
MsgBox ("Add meg a fogadóállást a " & cella.Offset(, 4).Address & " cellában!")
Cancel = True
End Ifüdv
-
-
Mittu88
senior tag
válasz
Mittu88
#19542
üzenetére
Na jó, rájöttem, hogy így se lesz jó.
Az a k.. érvényesítés így se fogja elfogadni.
Szóval a lényeg az lenne:
Van egy költséghely lista, pl:
1000 üzem
2000 raktár
3000 központi irányítás
stb.A lényeg az lenne, hogy legördülő listával lehessen a költséghelyet kiválasztani, alatta egy másik cellában szintén legördülő listával az jelenjen meg, hogy azon a költséghelyen milyen nyomtatók vannak (ehhez is van adatbázis).
pl ha kiválasztja, hogy Üzem:
Epson xy
HP xy
...Ha átállítja raktárra:
Samsung xy
Konica Minolta xy
...és így tovább.
Ezt hogy lehet megoldani? Szerintem VBA-ban egyszerű lehet, de ahhoz nem értek annyira :/
Érvényesítéssel meg szűrővel szenvedek, de rossz végén állok a brének
-
Mutt
senior tag
válasz
Mittu88
#19539
üzenetére
Hello,
Kiegészítheted a korábbi makrót ezzel a sorral.
Worksheets("masik lap").Columns("A:D").AutoFilter Field:=1, Criteria1:=Range(cella).Value
Így lefut a szűrés minden alkalommal.
A gond, hogy pont emiatt erőforrás pazarló, ezért egy kicsit lehet hangolni rajta:
Dim EredetiErtek
Const cella As String = "A2"
Private Sub Worksheet_Calculate()
'kikapcsoljuk az eseménykezelést, mivel a következősor újabb eseményt (change) indítana el
Application.EnableEvents = False
'értéket másolunk eggyel a keresett cella alá
Range(cella).Offset(1).Value = Range(cella).Value
'eseménykezelést visszakapcsoljuk
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'csak akkor engedjük futni a szűrést, ha változott a szűrési feltétel
If EredetiErtek <> Range(cella).Value Then
Worksheets("UDF").Columns("A:D").AutoFilter Field:=1, Criteria1:=Range(cella).Value
EredetiErtek = Range(cella).Value
End If
End Subüdv
Új hozzászólás Aktív témák
Fferi50- BESZÁMÍTÁS! ASUS ROG Crosshair VIII Extreme alaplap garanciával hibátlan működéssel
- Microsoft Surface Pro 9 i5-1245U 16GB 1000GB 1 év garancia
- HIBÁTLAN iPhone 13 Pro Max 256GB Gold -1 ÉV GARANCIA -Kártyafüggetlen, MS3758, 91% Akkumulátor
- HIBÁTLAN iPhone 13 256GB Red -1 ÉV GARANCIA - Kártyafüggetlen, MS3735, 91% Akkumulátor
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 32/64GB RAM RX 9070 XT 16GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Promenade Publishing House Kft.
Város: Budapest