-
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
-
Delila_1
Topikgazda
Az indító lapodhoz rendeld a kódot. A lapon bármit beírva a Q oszlopba a nevet és az email címet átmásolja a "Másolat" lap A és B oszlopába, az utolsó kitöltött sor alá.
Az első lapon a "bármi"-t törölve a Q oszlopból, törlődik a két adat sora a "Másolat" lapról.
Jól mutat, ha az első lap Q oszlopát Wingdings-re állítod, és jelölésnek ü karaktert viszel be, ami egy pipa jelet ad.Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 17 Then
Dim név$, email$, sor%, usor%, WS2 As Worksheet
Set WS2 = Sheets("Másolat")
név$ = Cells(Target.Row, 1).Value
email$ = Cells(Target.Row, 3).Value
usor% = WS2.Range("A" & Rows.Count).End(xlUp).Row + 1
If IsEmpty(Target) Then
For sor% = 2 To usor%
If WS2.Range("A" & sor%) = név$ And WS2.Range("C" & sor%) = email$ Then
WS2.Rows(sor%).Delete Shift:=xlUp
Exit Sub
End If
Next
Else
WS2.Cells(usor%, 1) = név$
WS2.Cells(usor%, 2) = email$
End If
End If
End SubA Set WS2 = Sheets("Másolat") sorban adhatod meg a saját lapod nevét a Másolat helyett.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Szia Marci!
Jó sokára jelentkeztél az újabb problémával. Itt a kibővített makró:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim név$, email$, sor%, usor%, oszlop As Integer, lapnév$
oszlop = Target.Column
If Target.Column > 2 And Target.Column < 6 Then
Select Case oszlop
Case 3
lapnév$ = "Másolat_1"
Case 4
lapnév$ = "Másolat_2"
Case 5
lapnév$ = "Másolat_3"
End Select
név$ = Cells(Target.Row, 1).Value
email$ = Cells(Target.Row, 2).Value
usor% = Sheets(lapnév$).Range("A" & Rows.Count).End(xlUp).Row + 1
If IsEmpty(Target) Then
For sor% = 2 To usor%
If Sheets(lapnév$).Range("A" & sor%) = név$ And _
Sheets(lapnév$).Range("B" & sor%) = email$ Then
Sheets(lapnév$).Rows(sor%).Delete Shift:=xlUp
Exit Sub
End If
Next
Else
Sheets(lapnév$).Cells(usor%, 1) = név$
Sheets(lapnév$).Cells(usor%, 2) = email$
End If
End If
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
Nem sokat változtattam az előzőhöz képest. Csupán a Select Case ... End Select többirányú elágazásban adtam meg a lap nevét attól függően, hogy a 3 oszlop (C–E) közül melyikbe vittél be értéket, vagy töröltél egy előzőt.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- Kriptovaluták és az adózás
- Megérkezett a Corsair új M.2-es SSD-je, és mindennek mondható, csak lassúnak nem
- Építő/felújító topik
- Intel Core i5 / i7 / i9 "Alder Lake-Raptor Lake/Refresh" (LGA1700)
- Milyen billentyűzetet vegyek?
- nVidia tulajok OFF topikja
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Gitáros topic
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- EAFC 24
- További aktív témák...
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Ozeki Kft.
Város: Debrecen