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

• #40957 JagdPanther aktív tag

  Új Válasz 2019-05-02 13:52:02 #40957

  Ú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

  

  JagdPanther

  aktív tag

  Sziasztok
  van egy ilyen vba kódom, még elég gyorsan fut de azt hiszem a jövőben egy több száz soros táblában be fog lassulni.
  Hogyan lehet átírni úgy, hogy a funkcionalitás megmaradjon, de kevesebb számítási kapacitás kelljen neki?
  A táblázat egyébként így néz ki.

  Sub Ma()

Sheets("Bevitel").Range("B6").Select
ActiveCell.EntireRow.Insert Shift:=xlDown

ActiveCell.Value = Date

Range("E6").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Adat!$F$2:$F$8"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("F6").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Adat!$L$2:$L$3"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("C7:I7").Select
Selection.Copy
Range("C6:I6").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("J7").Select
Selection.Copy
Range("J6").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("C6").Select
ActiveCell.Select


End Sub
Sub Megse()

Rows(6).Delete

End Sub

Sub Hibakiadva()

Sheets("Bevitel").Range("H6").Select
ActiveCell.Value = Date

End Sub

Sub Hibaelvegezve()

ActiveCell.Select
ActiveCell.Value = Date

End Sub

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