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

• #18910 Mutt senior tag rtom #18909

  Új Válasz 2013-09-05 20:54:27 #18910

  Ú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

  

  Mutt

  senior tag

  válasz rtom #18909 üzenetére

  Hello,

  ...miért áll meg a debug a Range("B21:B" & usor). Select sornál....

  Az egyik probléma, hogy az usor-t rosszul határozod meg.
  A .Range("B21:B" & Rows.Count).End(xlDown).Row + 1 azt mondja, hogy menjen el az utolsó sorba és használja a következőt, az utolsó után már nincs sor.

  Ha a B21 után használt utolsó cella sora kell, akkor xlDown helyett xlUp-ot használj.

  A másik probléma itt, hogy a .Range("B21:B" & Rows.Count).End nem jó, mivel azt csinálod hogy B21:B1048576-os tartományt kijelölöd, a kurzor továbbra is B21-ben van, de nyomsz egy END-et vagyis elugorsz végre B1048576-re. Ez így felesleges, egy lépésben csináld: Range("B" & Rows.Count).End

  A kódban a Selectek miatt nem lehet követni, hogy éppen hova akarsz dolgozni. Valójában az aktív lapod nem változik, maradsz a beolvas-on, ezért javaslom, hogy rendesen írd ki, hogy éppen hol akarsz módosítani.
  pl. Range("B21:B" & usor).Select helyett
  ThisWorkbook.Sheets(lapnev).Range("B21:B" & usor).Select

  Végül pedig lehet pár dolgot egylépésben is csinálni.
  Range("D2").Select
  Selection.Copy

  helyette:
  Range("D2").Copy

  Vagy a végén:
  Sheets("beolvas").Select
  Range("A2").Select
  Selection.Clear

  helyette:
  Sheets("beolvas").Range("A2").Clear

  Itt van a javított változat:
  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim usor As Long
  Dim lapnev As String
  
  If Range("A2") <> Empty And Range("A4") = "OK" Then
  Range("D2").Copy
  lapnev = Range("F2")
  Sheets(lapnev).Select
  usor = ThisWorkbook.Sheets(lapnev).Range("B" & Rows.Count).End(xlUp).Row + 1
  
  ThisWorkbook.Sheets(lapnev).Range("B21:B" & usor).Select
  
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Sheets("beolvas").Range("A2").Clear
  End If
  End Sub

  üdv

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