MS Visual Basic, как отсортировать 1 массив и вернуть индекс для второго массива? - PullRequest
1 голос
/ 24 декабря 2011

язык, который я ищу, - MS Visual Basic.

Как я могу отсортировать массив и соответственно изменить другие массивы (используя индекс?) Я искал, но не смог найти ничего по этому поводу.Любая помощь очень ценится !!!

например, сортировать массив BirthArray и соответственно изменять порядок Array1 и ID?

Array1 = 'John', 'Christina','Mary', 'frediric', 'Johnny','billy','mariah'

BirthArray = 1998, 1923, 1983,1982,1924,1923,1954

ID = 12312321, 1231231209, 123123, 234324, 23423, 2234234,932423

Dim Array() As String

Dim BirthArray() As Integer

Dim ID() As Integer

Большое спасибо!

Ответы [ 2 ]

3 голосов
/ 24 декабря 2011

Вы должны создать класс для хранения значений, поместить коллекцию классов в список, а затем отсортировать список с помощью лямбда-выражения:

Public Class Info
    Public Property Name As String
    Public Property BirthYear As Integer
    Public Property ID As Integer

    Public Sub New()
    End Sub
    Public Sub New(sName As String, wBirthYear As Integer, wID As Integer)
        Me.New
        Me.Name = sName
        Me.BirthYear = wBirthYear
        Me.ID = wID
    End Sub
End Class

Public Sub DoSort()
    Dim cRecords As New System.Generic.List(Of Info)

    cRecords.Add(New Info('John', 1998, 12312321)
    ' ToDo: Add more records

    cRecords.Sort(
    Function (ByVal oItem1 As Info, ByVal oItem2 As Info) 
       Return oItem2.BirthYear.CompareTo(oItem1.BirthYear)
    End Function)

End Sub
1 голос
/ 24 декабря 2011

Предлагаемый солютон ниже (на основе вашего тега VBA).

  1. создает двумерный массив из 3 отдельных массивов (как предложено Джесси)
  2. использует Redim Preserve для добавления четвертого набора данных "NewData" в двумерный массив "ArrayMaster"
  3. создает временный рабочий лист, выгружает "ArrayMaster" , сортирует по "Newdata" (в порядке возрастания) для создания отсортированного массива, "ArrayMaster2"
  4. удаляет рабочий лист

Excel очень эффективен при сортировке, поэтому этот метод предоставил простой и быстрый способ сортировки (или многоуровневой сортировки)

Вы можете использовать метод пузырьковой сортировки , если Excel не был доступен для дампа / сортировки листов

Option Base 1
Sub ComboArray()
Dim ws As Worksheet
Dim Array1()
Dim Birthday()
Dim ID()
Dim NewData()
Dim ArrayMaster()
Dim ArrayMaster2()
Dim lngRow As Long
Dim lngCalc As Long
Dim lngCheck As Long

Birthday = Array(1998, 1923, 1983, 1982, 1924, 1923, 1954)
Array1 = Array("John", "Christina", "Mary", "frediric", "Johnny", "billy", "mariah")
ID = Array(12312321, 1231231209, 123123, 234324, 23423, 2234234, 932423)
ReDim ArrayMaster(1 To UBound(Array1, 1), 1 To 3)

'Create 2D MasterArray
For lngRow = 1 To UBound(Array1, 1)
    ArrayMaster(lngRow, 1) = Array1(lngRow)
    ArrayMaster(lngRow, 2) = Birthday(lngRow)
    ArrayMaster(lngRow, 3) = ID(lngRow)
Next

NewData = Array(1, 3, 5, 7, 2, 4, 6)

'Check if new field is longer than overall array
If UBound(NewData, 1) > UBound(ArrayMaster, 1) Then
lngCheck = MsgBox("New field exceeds current array size, proceeding will drop off excess records" & vbNewLine & "(Press Cancel to end code)", vbOKCancel, "Do you want to proceed?")
If lngCheck = vbCancel Then Exit Sub
End If

'Add NewData field
ReDim Preserve ArrayMaster(UBound(ArrayMaster, 1), UBound(ArrayMaster, 2) + 1)
For lngRow = 1 To UBound(NewData, 1)
    ArrayMaster(lngRow, UBound(ArrayMaster, 2)) = NewData(lngRow)
Next
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    lngCalc = .Calculation
End With

'Create working sheet, dump MasterArray and sort by Newdata (position 4 = cell D1)
Set ws = Worksheets.Add
ws.[a1].Resize(UBound(ArrayMaster, 1), UBound(ArrayMaster, 2)).Value2 = ArrayMaster
ws.UsedRange.Sort ws.[d1], xlAscending
'Create our sorted array MasterArray2, now with NewData(1,2,3,4,5,6,7)
ArrayMaster2 = ws.[a1].Resize(UBound(ArrayMaster, 1), UBound(ArrayMaster, 2)).Value2
ws.Delete

'cleanup working sheet
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .Calculation = lngCalc
End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...