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

• #11567 Delila_1 veterán mr.nagy #11565

  Új Válasz 2011-10-05 08:03:03 #11567

  Ú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

  

  Delila_1

  veterán

  válasz mr.nagy #11565 üzenetére

  Teszteld ezzel. Csak estefelé leszek gép közelében, addig biztosan kibuknak a hibák.
  A makró első részében (a **-os sorig) az első lap 100. oszlopába teszek egy x-et ahhoz, hogy a második rész gyorsabb futású legyen. Ezt az oszlopot a végén törlöm. Ha foglalt a 100. oszlop (CV), a 100-at a replace funkcióval írd át egy üres oszlop számára. Négy helyen szerepel.

  Sub szamitas()
  Dim WS1 As Worksheet, WS2 As Worksheet, sor%, usor1%, usor2%, lel
  
  Set WS1 = Sheets("első")
  Set WS2 = Sheets("második")
  WS2.Select
  
  usor1% = Range("G2").End(xlDown).Row
  For sor% = 2 To usor1%
  On Error GoTo Köv
  lel = WS1.Range("E:E").Find(Cells(sor%, "E")).Row
  Select Case WS1.Cells(lel, 1)
  Case 380
  Cells(sor%, 7) = WS1.Cells(lel, 7) + Cells(sor%, 7)
  WS1.Cells(lel, 100) = "x"
  Case 390
  Cells(sor%, 7) = WS1.Cells(lel, 7) - Cells(sor%, 7)
  WS1.Cells(lel, 100) = "x"
  
  End Select
  Köv:
  Next
  '***************************************************************************
  WS1.Select
  usor1% = Range("A2").End(xlDown).Row
  
  For sor% = 2 To usor1%
  If Cells(sor%, 1) = 380 And Cells(sor%, 100) <> "x" Then
  usor2% = WS2.Range("E2").End(xlDown).Row + 1
  Range(Cells(sor%, 2), Cells(sor%, 5)).Copy WS2.Cells(usor2%, 2)
  Cells(sor%, 7).Copy WS2.Cells(usor2%, 7)
  End If
  Next
  Columns(100) = ""
  End Sub

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