Как сортировать строки в листе Excel и печатать в файл, используя скрипт VB?

Question

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

Моя таблица, которая содержит заголовок в качестве имени ученика 1, 2, 3 и т. Д. И соответствующие отметки как 1, 2, 3, 4 и "-".

Я хочу написать функцию в VB для сортировки соответствующих строк по каждому предмету (0,1,2,3, ... 7) итакже выведите значения в файл.

output (file.txt)

NULL,NULL,NULL,NULL,NULL
STUDENT 2 ,STUDENT 5 ,STUDENT 4 ,NULL,NULL
STUDENT 4,STUDENT 5,NULL,NULL,NULL
etc.. 

столбцы в строке должны быть отсортированы в порядке возрастания, и если "-" присутствуетв любом столбце должно быть напечатано как NULL как оставшиеся значения.

Я написал

Sub test()
'create and write into file txt
Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")

    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile("MyFile.txt", True, True)

    'Write logic for sorting 

    Fileout.Close

End Sub

Как отсортировать в Excel с помощью сценария VB и распечатать эти строки?

Answer 1

Вот способ реализовать это, адаптировать его к вашим потребностям:

' Naive O(N^2) sort
Sub Sort(arr() As Long, students() As String)
    If UBound(arr) <= 1 Then Exit Sub

    Dim i As Long, j As Long
    For i = 0 To UBound(arr) - 1
        ' Look for the minimum index in the sub-array going from i
        Dim indexOfMin As Long
        indexOfMin = i
        For j = i To UBound(arr)
            If arr(j) < arr(indexOfMin) Then
                indexOfMin = j
            End If
        Next j
        ' Put the minimum mark at the beginning of the sub-array
        Dim tmp As Variant
        tmp = arr(i)
        arr(i) = arr(indexOfMin)
        arr(indexOfMin) = tmp
        ' Put the student with the minimum value at the beginning of the students sub-array
        tmp = students(i)
        students(i) = students(indexOfMin)
        students(indexOfMin) = tmp
    Next i
End Sub

Sub SortAndSave()
    Dim dataRange As Range
    Set dataRange = Range("A1:F9")

    Dim data As Variant
    data = dataRange.Value

    Dim NSubject As Long, NStudents As Long
    NSubject = UBound(data, 1) - 1
    NStudents = UBound(data, 2) - 1

    Dim text As String
    Dim i As Long, j As Long
    For i = 1 To NSubject
        ' Read marks and students names
        Dim subjectMarks() As Long
        ReDim subjectMarks(0 To NStudents - 1)
        Dim students() As String
        ReDim students(0 To NStudents - 1)
        For j = 1 To NStudents
            ' Use a big enough number 999 so that students with no mark will be pushed to the end
            subjectMarks(j - 1) = IIf(data(i + 1, j + 1) <> "-", data(i + 1, j + 1), 999)
            students(j - 1) = data(1, j + 1)
        Next j

        ' Sort marks and students
        Sort subjectMarks, students

        ' Build display row for subject
        Dim row As String
        row = ""
        For j = 1 To NStudents
            ' If there is a mark render the student name
            If subjectMarks(j - 1) <> 999 Then
                row = row & students(j - 1)
            ' Otherwise render NULL
            Else
                row = row & "NULL"
            End If
            ' Add a comma if not the latest
            If j <> NStudents Then
                row = row & ","
            End If
        Next j
        text = text & row
        ' Add a \r\n if not the latest
        If i <> NSubject Then
            text = text & vbCrLf
        End If
    Next i
End Sub

Результат:

NULL,NULL,NULL,NULL,NULL
STUDENT 2,STUDENT 5,STUDENT 4,NULL,NULL
STUDENT 4,STUDENT 5,NULL,NULL,NULL
STUDENT 4,STUDENT 5,NULL,NULL,NULL
STUDENT 2,STUDENT 5,STUDENT 4,NULL,NULL
STUDENT 5,STUDENT 4,STUDENT 2,STUDENT 1,NULL
STUDENT 5,STUDENT 4,STUDENT 2,STUDENT 1,NULL
STUDENT 4,STUDENT 5,NULL,NULL,NULL