按最大到最小字符串排序一列



我试图排序我的每一个excel文件的一列,有大长度的文本。这样,当使用数据服务作业导入SQL时,数据就不会被截断。我意识到Excel读取前8或16行,并基于此确定字段的长度,我的很多文本被切成255个字符。

我尝试了一个文件作为实验,列设置为399 varchar,这是其中一个文件中最长字符串的长度。无论我在DS作业映射中设置了多少字段,字符串的长度都将设置字段的大小。

我已经创建了一个VBA的小片段,通过每个文件循环,并按最大到最小的文本排序,它正在循环,正在做一些事情,但不是排序最大到最小。

不确定它是空单元格还是导致它的原因,但是我设法手动为一个文件做这个-排序从大到小-现在它从不说从大到小,只有A> Z出于某种原因。

我对代码有一个问题,那就是我提到的它不是排序,2)我有一个关于处理多个文件和确定最大字段长度的问题。我不知道DS作业是否会改变字段大小,如果它遇到另一个文件的文本长度比最后一个大?我对一个文件执行了此操作,但这并没有告诉我,唯一的方法是尝试对多个文件进行适当排序,然后对每个文件运行作业。

这是我尝试进行排序时的循环。我找到名为"sort Me"的列作为示例,然后对其应用排序。

 For i = 1 To lastcol
        With wb.ActiveSheet
            ColChar = colLtr(i)
            rangestr = ColChar & "1:" & ColChar & "" & MaxRowCount
             If .range(ColChar & 1).Value = "Sort Me" Then
                range(rangestr).Sort key1:=range(rangestr), order1:=xlDescending, Orientation:=xlSortRows, Header:=xlYes
            End If
        End With
    Next i

我有一个从列号创建列字符的函数。我循环遍历每一列,直到找到我想要的那一列,然后尝试排序。变量rangestr是我要排序的范围。

编辑:澄清我想要文本字段最长的顶部和最短的底部,有,null,一些工作表没有文本。这样的:

"This is the longest piece of text to be a top"
"This is shorter piece of text"
"This is even shorter"

main至少希望首先正确地完成排序。寻求建议如何正确地做到这一点。

多谢安德鲁

Excel有强大的内置排序功能,我更愿意使用它,因为它的实际速度更快,而不是重新发明轮子

如果您需要一个新的(临时的)字段—其中包含文本长度—我还将使用"helper"字段方法和代码如下:

Sub SortIt(dataRng As Range, headerStrng As String)
    Dim f As Range, helpRng As Range
    Dim colsOffset As Long
    With dataRng
        Set f = .Rows(1).Find(what:=headerStrng, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--| look for wanted header column
        If f Is Nothing Then Exit Sub '<--| if no header found, then no job to do!
        Set helpRng = .Resize(, 1).Offset(, .Parent.UsedRange.Columns(.Parent.UsedRange.Columns.Count).Column - .Columns(1).Column + 1) '<--| set a helper range in first column outside worksheet used range and occupying data range same rows
        With helpRng
            colsOffset = .Column - f.Column + 1 '<--| calculate column offset from "header" column to "helper" range
            .FormulaR1C1 = "=len(RC[-" & colsOffset - 1 & "])" '<--| fill "helper" range with corresponding "header" cells number of characters. they will be eventually cleared
        End With
        .Resize(, helpRng.Column - .Columns(1).Column + 1).Sort key1:=helpRng, order1:=xlDescending, Orientation:=xlSortColumns, Header:=xlYes
        helpRng.Clear '<--| clear the "helper" range
    End With
End Sub

被你的主子调用如下:

Option Explicit
Sub main()
    Dim dataRng As Range, headerStrng As String
    With Worksheets("SortData") '<--| change "SortData" with your actual sheet name
        Set dataRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 10) '<--| change "A1", "A" and '10' to reflect, respectively, your  data actual leftupmost cell, "counter" column (i.e. the one that determines its rows span) and columns number
    End With
    headerStrng = "Sort me" '<--| change "Sort me" with your actual header
    SortIt dataRng, headerStrng
End Sub

基于我在这里找到的代码片段
我编辑的代码如下所示,只需传递要排序的范围,如果要按最短长度

排序,则将可选参数设置为true
Sub SortByLength(rangeToSort As Range, Optional shortest As Boolean = False)
    Dim x As Long, y As Long, lLastRow As Long
    Dim tempX As String, tempY As String
    Dim tempArray As Variant
    tempArray = rangeToSort
    'Sort array
    For x = 1 To UBound(tempArray)
        For y = x To UBound(tempArray)
            If shortest = True Then
                If Len(tempArray(y, 1)) < Len(tempArray(x, 1)) Then
                    tempX = tempArray(x, 1)
                    tempY = tempArray(y, 1)
                    tempArray(x, 1) = tempY
                    tempArray(y, 1) = tempX
                End If
            Else
                If Len(tempArray(y, 1)) > Len(tempArray(x, 1)) Then
                    tempX = tempArray(x, 1)
                    tempY = tempArray(y, 1)
                    tempArray(x, 1) = tempY
                    tempArray(y, 1) = tempX
                End If
            End If
        Next y
    Next x
    'Output sorted array
    Range(rangeToSort.Item(1), rangeToSort.Item(UBound(tempArray))) = (tempArray)
End Sub

最新更新