Как отсортировать список данных в определенные строки / столбцы с помощью VBA? - PullRequest
0 голосов
/ 10 июня 2019

У меня есть список из 31 500 уникальных номеров.Мне нужно отсортировать список на куски по 250 в каждом столбце для 4 столбцов, а затем циклически переместиться под верхние 4 и повторить процесс до конца списка.

Я уже пробовал и смог отсортировать список только по столбцам, но не циклично внизу.

Sub ExportData(division As Integer)

    Dim cols As New Collection
    Dim rows As New Collection

    Dim counter As Integer
    counter = 0

    Dim fileCounter As Integer
    fileCounter = 0

    Dim fileContent As String
    fileContent = ""

    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("select * from activity1")

    Set rows = New Collection

    While Not rs.EOF
        rows.Add rs("Field1").Value
        counter = counter + 1
        If counter = division Then
            fileCounter = fileCounter + 1
            counter = 0
            cols.Add rows
            Set rows = New Collection
        End If
        rs.MoveNext
    Wend

    If counter > 0 Then
        fileCounter = fileCounter + 1
        counter = 0
        cols.Add rows
    End If

    Dim i_col As Integer
    Dim j_row As Integer
    Dim rowText As String

    For j_row = 1 To division
        For i_col = 1 To fileCounter
            On Error Resume Next
            If i_col = fileCounter Then
                rowText = rowText & cols(i_col)(j_row)
            Else
                rowText = rowText & cols(i_col)(j_row) & ","
            End If
        Next
        rowText = rowText & vbCrLf
    Next
End Sub

Пример форматирования мне нужно

1 Ответ

1 голос
/ 11 июня 2019

Это должно работать. Вы можете изменить вертикальный (maxChunk) или горизонтальный (maxCol) размеры.

Option Explicit

Sub doit()

    Dim rs As adodb.Recordset
    Set rs = New adodb.Recordset
    rs.Open "Select * From activity1 Order By Field1", CurrentProject.Connection, _
         adOpenKeyset, adLockOptimistic

    rs.MoveLast
    rs.MoveFirst

    ' Inhale ALL of the records into an array (base zero)
    Dim varRecords As Variant, maxRecCnt As Long
    varRecords = rs.GetRows(rs.RecordCount, , "Field1") '(rs.RecordCount)
    maxRecCnt = UBound(varRecords, 2)

    Debug.Print maxRecCnt

    Dim x As Long
    ' expected output
    ' A     B   C   D   E   F   G   H
    ' 1     6   11  16  21  26  31  36
    ' 2     7   12  17  22  27  32  37
    ' 3     8   13  18  23  28  33  38
    ' 4     9   14  19  24  29  34  39
    ' 5     10  15  20  25  30  35  40
    '41

    Dim allText As String

    Dim maxChunk As Long, rowInChunk As Long, numChunk As Long
    maxChunk = 5
    rowInChunk = 0

    Dim maxCol As Long, numCol As Long
    maxCol = 8
    numCol = 0

    For numChunk = 1 To maxRecCnt / maxChunk * maxCol
            For rowInChunk = 1 To maxChunk

                    Dim rowText As String
                    rowText = ""
                    For numCol = 1 To maxCol
                        ' compute which cell in the array we want
                        x = ((numCol - 1) * maxChunk) + rowInChunk - 1 + ((numChunk - 1) * maxChunk * maxCol)
                        On Error Resume Next  ' widows at the end
                        rowText = rowText & vbTab & varRecords(0, x)
                    Next numCol

                    'MsgBox (rowText)
                    allText = allText & vbCrLf & rowText

            Next rowInChunk
            allText = allText & vbCrLf

    Next numChunk

    MsgBox (allText)

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...