帮助排序数据 [英] Help in sorting data

问题描述

我写了下面的代码，但它不能正常工作。



我在A1单元格中有以下数据（用分号分隔的数值）

A; C; B; M; U



ConvertToColumn （）产生输出为

A

C

B

M

U



sSortSelection（）按上述输出按升序生成输出，但仅限于我们选择特定范围时。



generateRow（）生成排序后的输出为

A; B; C; M; U





但是当我运行final（）函数时，我无法获得正确的输出。谁能告诉我哪里出错了？



以下是我的全部代码：

Hi,

I have written the below code but its not working as i wanted.

I have below data in A1 cell (values separated by semi-colon)
A;C;B;M;U

ConvertToColumn() produces output as
A
C
B
M
U

sSortSelection() produces output in ascending order for above output but only when we select that particular range.

generateRow() produces the sorted output as
A;B;C;M;U


But when i run the final() function i am not able to get the correct output. Can anyone please let me know where i am going wrong?

Below is my whole code:

Option Explicit

Sub ConvertToColumn()
    
   
    ' constants
    
    Const ksInputWS = "Sheet1"
   Const ksInputRange = "A1"
    Const ksOutputWS = "Sheet1"
   Const ksOutputRange = "B1"
    ' declarations
    Dim rngI As Range, rngO As Range
    Dim lRowI As Long, iColI As Integer, lRowO As Long, iColO As Integer
    Dim i As Long, J As Long, K As Integer, a As String, b As String
    Dim sArray() As String
    ' start
    Set rngI = Worksheets(ksInputWS).Range(ksInputRange)
    Set rngO = Worksheets(ksOutputWS).Range(ksOutputRange)
    With rngI
        lRowI = .Row
        iColI = .Column
    End With
    With rngO
        lRowO = .Row
        iColO = .Column
        .ClearContents
    End With
    
   
    ' process
    i = lRowI
    J = lRowO - 1
    With rngI
        Do Until .Cells(i, iColI).Value = ""
            ' row
            a = .Cells(i, iColI).Value
            ' split & fill
            sArray = Split(a, ";")
            For K = LBound(sArray()) To UBound(sArray())
                J = J + 1
                rngO.Cells(J, iColO).Value = sArray(K)
            Next K
            ' blank
            J = J + 1
            rngO.Cells(J, iColO).Value = ""
            ' cycle
            i = i + 1
        Loop
    End With
    ' end
 
  
    Beep
End Sub



Sub generateRow()

Dim i As Integer
Dim s As String

i = 1

Do Until Cells(i, 1).Value = ""
    If (s = "") Then
        s = Cells(i, 1).Value
    Else
        s = s & ";" & Cells(i, 1).Value
    End If
    i = i + 1
Loop

Cells(1, 5).Value = s

End Sub

Public Sub sSortSelection()

'use the keyword "Selection" for the currently selected range (i think the issue is here itself but not sure what to use here instead)
With ActiveSheet.sort
    .SortFields.Clear

    .SortFields.Add Key:=Selection.Columns(1), Order:=xlAscending
    .SetRange Selection
    .Apply
End With

End Sub

Sub final()
SplitAndTranspo
sSortSelection
generateRow
End Sub

提前致谢



问候，

Archie



[edit]已添加代码块 - OriginalGriff [/ edit]

Thanks in advance

Regards,
Archie

[edit]Code block added - OriginalGriff[/edit]

推荐答案

试试这个：

Try this:

Option Explicit

'Copy & Paste with Trasnpose option
Sub Cols2Rows1()
Dim sInputCell As String, sOutputString As String
Dim rng As Range, i As Integer

sInputCell = "A1"
Set rng = ThisWorkbook.Worksheets(1).Range(sInputCell)
rng = "A;C;B;M;U;E;N;D"

rng.TextToColumns Destination:=rng, DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:=";"
        
ThisWorkbook.Worksheets(1).Range(rng, rng.End(xlToRight)).Copy
Set rng = ThisWorkbook.Worksheets(2).Range(sInputCell)
rng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
rng.Sort Key1:=rng, Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
i = 1
Do While ThisWorkbook.Worksheets(2).Range("A" & i) <> ""
    sOutputString = sOutputString & ThisWorkbook.Worksheets(2).Range("A" & i) & ";"
    i = i + 1
Loop

sOutputString = Left(sOutputString, Len(sOutputString) - 1)
ThisWorkbook.Worksheets(1).Cells.Clear
ThisWorkbook.Worksheets(2).Cells.Clear
ThisWorkbook.Worksheets(1).Range(sInputCell) = sOutputString

MsgBox "Sorted!"

End Sub

Hi Maciej，



感谢您的代码。但rng中的值不应该是硬编码的。它应该采用A列中的所有值，对它们进行排序，然后为其添加分隔符。

我尝试将此代码与我的代码合并，几乎没有更改但是只剩下第一个单元格值，其他值是消失:(



问候，

Hi Maciej,

Thanks for the code. But the value in "rng" should not be hardcoded. it should take all the values present in column A, sort them and then add delimiter to it.
I tried merging this code with mine with few changes but then only first cell value is remaining and other values are disappearing :(

Regards,

这篇关于帮助排序数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！