简体   繁体   中英

Excel 2013 VBA Sort by rank

So here is the problem:

I need to interpolate values that are input to a template. Sounds easy, right? Well the problem is, those values aren't always in numerical order so it messes up my interpolation function. My interpolation function has an input of x values (in this case HP, this is the parameter that needs to be sorted numerically without messing up the data related to it), y values (the parameter you want to find at ?HP) and the x_value where you would like to find the y parameter. Some of the y parameters are equations so I couldn't think of a way to completely reorder the columns without messing up the data. I think there should be a way to reference the rank of the HP in the set, pick the related y value, and use those values to interpolate. That being said, I can't seem to figure out how to do it. I've been working on some code for quite a while. I've never actually used VBA before so it's been giving me a run for my money. The code I have thus far is as follows:

Function organize(ByVal x As Object)

' Declarations for finding Ranks
Dim Array_Size As Integer
Array_Size = Application.WorksheetFunction.Count(x.cells) + Application.WorksheetFunction.CountBlank(x.cells)

Dim Ranks As Variant
ReDim Ranks(1 To Array_Size)
Dim j As Integer  'initiate counter

For j = 1 To Array_Size

    If x.cells(j).Value <> 0 Then

        Ranks(j) = Application.WorksheetFunction.Rank_Eq(x.cells(i).Value, x.cells, 1) 'assign rank to i'th position in array

    End If

Next j

organize = Ranks()


End Function


Function lin_2xy(ByVal x1 As Single, ByVal y1 As Single, _
                 ByVal x2 As Single, ByVal y2 As Single, _
                 ByVal x_value As Single)

If x1 = x2 Then
   lin_2xy = [#N/A]
Else
   lin_2xy = y1 + (y2 - y1) / (x2 - x1) * (x_value - x1)
End If

End Function


Function Sort_Then_Interpolate(ByVal x As Object, ByVal y As Object, ByVal x_value As Single)

'Declarations for interpolating
Dim i As Integer                ' counter.
Dim Current_x As Single       ' x value
Dim Next_x As Single          ' next higher x value
Dim Current_y As Single        ' y value
Dim Next_y As Single           ' next higher y value
Dim LFound As Boolean           ' = true if found.
Dim matrix() As Variant

matrix = organize(x.cells)

LFound = False

For i = 1 To UBound(matrix)

match_value = Application.WorksheetFunction.Match(i, matrix, 0)
next_match = Application.WorksheetFunction.Match(i + 1, matrix, 0)

Current_x = x.cells(match_value).Value
Next_x = x.cells(next_match).Value
Current_y = y.cells(match_value).Value
Next_y = y.cells(next_match).Value

   If ((Current_x - x_value) * (Next_x - x_value) <= 0#) Then
      Sort_Then_Interpolate = lin_2xy(Current_x, Current_y, Next_x, Next_y, x_value)
      LFound = True

   End If
Next i

If (LFound = False) Then Sort_Then_Interpolate = [#N/A]

End Function

在此处输入图片说明

if that can help, you can sort a range in excel ( 'Home' Tab > 'Sort & Filter> ...) i recorded a simple macro (sort A to Z in a given selected range):

Sub Macro3()
' This is an example code, from the record tool in excel, can be much upgraded...
' Sort A to Z
' change range to your needings

'
Range("A23:F27").Select
ActiveWorkbook.Worksheets("Epée batarde").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Epée batarde").Sort.SortFields.Add Key:=Range( _
    "A23"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Epée batarde").Sort
    .SetRange Range("A23:F27")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

I think you use too much worksheetfunction, but really i didnt quite get your goal... use Option explicit at the begin of your modules.

Functions return values, wich you might want to declare (easier to read , to us at least)

Function NameFunc (byval argument1 as Range, ...) as bolean 'or something

after LFound = True , maybe you can add exit for.

Array_Size = Application.WorksheetFunction.Count(x.cells) + Application.WorksheetFunction.CountBlank(x.cells)

really writes like this:

'assuming x is a range or a worksheet, and not an object like you said, its like calling a chicken a bird)

'if x is a worksheet:
with x
    Array_Size = .cells( .rows.count,1).end(xlup).rows
end with

'if x is a range :
Array_Size = x.rows.count 'for counting rows
Array_Size = x.cells.count 'for counting number of cells

Maybe you can post a screen capture of your worksheet to help. have a good evening

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM