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

• #11728 m.zmrzlina senior tag sonar #11721

  Új Válasz 2011-10-17 12:32:08 #11728

  Ú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

  

  m.zmrzlina

  senior tag

  válasz sonar #11721 üzenetére

  A következő elrendezést és Excel2007-et feltételezve a következő lehet egy megoldás:

  

  A:B tartomány lefelé folytatódik.

  És a makró:

  Sub minmax()
  Dim min As Single
  Dim max As Single
  Dim tipus As String
  Dim i As Integer
  
  For i = 1 To Range("A1048576").End(xlUp).Row
  
  Cells(i, 1).Select
  tipus = ActiveCell.Value
  min = ActiveCell.Offset(0, 1).Value
  min = ActiveCell.Offset(0, 1).Value
  
  If Application.WorksheetFunction.CountIf(Range("D:D"), tipus) = 0 Then
  Do While ActiveCell.Value <> ""
  If ActiveCell.Value = tipus Then
  If ActiveCell.Offset(0, 1).Value <= min Then
  min = ActiveCell.Offset(0, 1).Value
  If ActiveCell.Offset(0, 1).Value >= max Then
  max = ActiveCell.Offset(0, 1).Value
  End If
  End If
  End If
  ActiveCell.Offset(1, 0).Select
  Loop
  
  Cells(Range("D1048576").End(xlUp).Row + 1, 4).Value = tipus
  Cells(Range("E1048576").End(xlUp).Row + 1, 5).Value = min
  Cells(Range("F1048576").End(xlUp).Row + 1, 6).Value = max
  
  End If
  
  Next
  
  End Sub

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