Új hozzászólás Aktív témák

• #37542 tgumis tag Delila_1 #37540

  Új Válasz 2018-03-18 10:27:16 #37542

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  tgumis

  tag

  válasz Delila_1 #37540 üzenetére

  Szia
  Köszi logitechh és Delila_1
  A logitechh verziója müxik viszont Delilia a tiédnél valamiért már az elején hibát dob:
  
  
  Mikor okoz észrevehető lassulást a logitechh által készített verzió?
  Mert - félre ne értsd logitechh - inkább a Delila_ verzióját preferálnám ha nagyon lassít. Már csak attól a hiba üzenettől kellene megszabadulni vhogy.
  Amúgy közveb kisérletezgettem a msg boxal és sikerült nekem is kitalálni egyfajta megoldást. Persze gondolom ennél jóval egyszerűbb a Delila megoldása( de ő profi míg én lelkes amatőr lennék)
  Íme:
  Sub message_box_szur_masol_beilleszt_()

Dim Answer As String
Dim MyNote As String
'itt adod meg a kérdést
'Place your text here
MyNote = "Rögzíted az adatokat?"

'itt adod meg a msg box címét
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Rögzítés")

If Answer = vbNo Then
'Code for No button Press
MsgBox "Az adatok nem lesznek áttöltve az ÖSSZESÍTÉS munkalapra!"
Else
'Code for Yes button Press
MsgBox "Az adatok áttöltéser kerülnek az ÖSSZESÍTÉS munkalapra viszont nem kerülnek törlésre a BEVITEL munkalapról!" & _
vbCrLf & "A folyamat nem visszavonható!!!!!!" '&vbCrLf & ez a sortörést jelzi


' bevitel munkalapon kijelöl másol összesítés munkalapon szűrés alapra álítása
' mindkét munkalapon jelszavas védelem feloldás másolás munkalapon a másolás utána jelszavas védelem beállítása
'
' kezdet
'
' bevitel munkalap védettség feloldás
Sheets("bevitel").Unprotect Password:="pw1234"
' összesítés munkalap védettség feloldás
Sheets("összesítés").Unprotect Password:="pw1234"
' összesítés munkalapon az 2.sorban a szűrés kikapcsolása majd bekapcsolása
' azért így van megoldva mert ha le van szűrve akkor minden sort megjelenít
' ugyanis nem tudni előre milyen szűrés volt alkalmazva az összesítés munkalapon
Sheets("összesítés").Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter
' szűrés a bevitel munkalapon a 17. oszlopban
Sheets("bevitel").Select
Sheets("bevitel").Range("D2").Activate
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK", Operator:=xlAnd
usor = Range("D2").End(xlDown).Row
' bevitel munkalap védetté tétele
Sheets("bevitel").Protect Password:="pw1234", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
' másolás
Range("D2:T" & usor).Select
Selection.Copy
'összesítés munkalap kijelölése
Sheets("összesítés").Select
Dim Asor As Long
Dim Bsor As Long
Dim i As Integer
' A oszloputolsó adat megkeresése majd a következő sor B oszlop elemét jelelöli ki
Asor = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("B" & Asor).PasteSpecial xlPasteValues

Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
' S3:V3 tartományban található képletek másolása és beillesztés a következő sorba
Range("S2:V2").Copy Destination:=Range("S" & Asor & ":S" & Bsor - 1)

For i = Asor To Bsor - 1
Range("A" & i) = Range("A" & i - 1) + 1
Next i
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
Sheets("összesítés").Protect Password:="pw1234", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
Sheets("bevitel").Select
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17
End If
End Sub

  Ez a logitechh makrójára épül mert akkor még nem láttam Delila_1 megoldását.

Új hozzászólás Aktív témák