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

• #10420 Delila_1 veterán m.zmrzlina #10418

  Új Válasz 2011-06-01 08:08:42 #10420

  Ú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 m.zmrzlina #10418 üzenetére

  A júzer által használt füzetbe, a munkalaphoz:

  Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
  Dim utvonal, Érték, sor%
  
  utvonal = Cells(Target.Row, 1)
  Érték = Cells(Target.Row, 2)
  sor% = Target.Row
  
  If Target.Column = 1 Then
  Darabteli utvonal, sor%
  End If
  
  If Target.Column = 2 Then
  Beír Érték
  End If
  Application.EnableEvents = True
  End Sub

  Szintén abba a füzetbe, modulba:
  Sub Darabteli(utvonal, sor%)
  Dim ws As Object
  Dim usor%
  Set ws = Workbooks("A.xls").Sheets("Munka1")
  usor% = ws.Range("B1").End(xlDown).Row + 1
  If Application.WorksheetFunction.CountIf(ws.Range("B:B"), utvonal) = 0 Then
  ws.Cells(usor%, 2) = utvonal
  Else
  Cells(sor%, 2) = Application.WorksheetFunction.VLookup(utvonal, ws.Columns("B:H"), 7, 0)
  End If
  End Sub

  Sub Beír(Érték)
  Dim ws As Object
  Dim usor%
  Set ws = Workbooks("A.xls").Sheets("Munka1")
  usor% = ws.Range("H1").End(xlDown).Row + 1
  ws.Cells(usor%, 8) = Érték
  End Sub

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