Блог

Итак, вот в чем проблема:

Мне нужно интерполировать значения, которые вводятся в шаблон. Звучит просто, не так ли? Ну, проблема в том, что эти значения не всегда находятся в числовом порядке, поэтому это портит мою функцию интерполяции. Моя функция интерполяции вводит значения x (в данном случае HP, это параметр, который необходимо отсортировать численно, не искажая связанные с ним данные), значения y (параметр, который вы хотите найти в?HP) и значение x_value, в котором вы хотели бы найти параметр y. Некоторые из параметров y являются уравнениями, поэтому я не мог придумать способ полностью изменить порядок столбцов, не испортив данные. Я думаю, что должен быть способ ссылаться на ранг HP в наборе, выбирать соответствующее значение y и использовать эти значения для интерполяции. При этом я, похоже, не могу понять, как это сделать. Я довольно долго работал над некоторым кодом. Я никогда раньше не использовал VBA, поэтому он давал мне возможность заработать свои деньги. Код, который у меня есть на данный момент, выглядит следующим образом:

 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
  

если это может помочь, вы можете отсортировать диапазон в Excel (вкладка «Главная»> «Сортировка и фильтр»> …) я записал простой макрос (сортировка от А до Я в заданном выбранном диапазоне):

 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
  

Я думаю, что вы используете слишком много worksheetfunction, но на самом деле я не совсем понял вашу цель…
используйте параметр явно в начале ваших модулей.

Функции возвращают значения, которые вы, возможно, захотите объявить (их легче читать, по крайней мере, для нас)

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

после LFound = True , возможно, вы можете добавить exit для .

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

действительно пишет так:

 '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
  

Возможно, вы можете опубликовать снимок экрана своего рабочего листа, чтобы помочь.
хорошего вечера