Question

我的VBA技能是基本的。我很感激帮助排序数字，但移动相应的字符串。例如，这些行：

╔═══════╦═════════╦═══════╦═════════╗
║ Name1 ║ Number1 ║ Name2 ║ Number2 ║
╠═══════╬═════════╬═══════╬═════════╣
║ Joe   ║       5 ║ John  ║      10 ║
╚═══════╩═════════╩═══════╩═════════╝

应该成为：

╔═══════╦═════════╦═══════╦═════════╗
║ Name1 ║ Number1 ║ Name2 ║ Number2 ║
╠═══════╬═════════╬═══════╬═════════╣
║ John  ║      10 ║ Joe   ║       5 ║
╚═══════╩═════════╩═══════╩═════════╝

我想要调整的代码是：

Sub hsort()
Dim lLast As Long, lLoop As Long
lLast = Cells(Rows.Count, 1).End(xlUp).Row
For lLoop = 2 To lLast
range(cells(lLoop,4),cells(lLoop,23)).Sort key1:=Cells(lLoop, 5), order1:=xlDescending,key2:=Cells(lLoop, 4), order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Next
End Sub

首先命令字符串然后是数字，而不是按照希望将它们一起移动。

Answer 1

假设Name1位于A1中，如果您在Name1和John之间临时添加一行，其中=IF(ISEVEN(COLUMN()),A3,B3)被复制到适合您应该达到的顺序I认为你需要正常的从左到右排序，然后可以删除临时行。如果您愿意，可以将其构建到VBA。

Answer 2

最后这是我采用的解决方案，但真的很慢！有没有人有任何改进此代码的建议？在我看来，词典是一个很好的解决方案，但我不知道如何使用它，所以我问你在这种情况下是否可以实现。

Sub Reorder()

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim i, c, j As Integer
i = 7

Do
j = 5
Do
Workbooks("Ownership Full v3.xlsx").Activate
Range(Cells(i, j), Cells(i, j + 1)).Copy
Workbooks("Book1.xlsx").Activate
If Range("A2") = blank Then
Range("A2").Select
Else
Range("A1").End(xlDown).Select
Selection.Offset(1, 0).Select
End If
ActiveSheet.Paste
j = j + 2
Workbooks("Ownership Full v3.xlsx").Activate
Loop While (j <= 23)

Workbooks("Book1.xlsx").Activate
    Range("B2:B11").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B11")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With


j = 5
c = 2
Do
Workbooks("Book1.xlsx").Activate
Range(Cells(c, 1), Cells(c, 2)).Cut
Workbooks("Ownership Full v3.xlsx").Activate
Cells(i, j).Select
ActiveSheet.Paste
c = c + 1
j = j + 2
Loop While (c <= 11)

i = i + 1

Loop While (Cells(i, 1) <> blank)

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

Answer 3

使用字典这很容易，但正如@pnuts指出的那样，它有点先进。我们在这里要做的是调用字典，将数据存储在那里，将它们传输到数组，按降序对它们进行冒泡排序，将它们放回字典中，然后打印出来。

哇。无论如何，为{}获得this site的奖励。

无论如何，首先是代码。

'http://www.xl-central.com/sort-a-dictionary-by-item.html
Sub SortDictionaryByItem()

    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)

    'Declare the variables
    Dim Dict As Scripting.Dictionary
    Dim Arr() As Variant
    Dim Temp1 As Variant
    Dim Temp2 As Variant
    Dim Txt As String
    Dim i As Long
    Dim j As Long
    Dim LastCol As Long, Iter As Long, Iter2 As Long, Iter3 As Long

    'Create an instance of the Dictionary
    Set Dict = New Dictionary

    'Set the comparison mode to perform a textual comparison
    Dict.CompareMode = TextCompare

    '''''''''''''''''BK201's Mod'''''''''''''''''

    'Get the last column of the row.
    LastCol = Range("A1").End(xlToRight).Column 'Modify accordingly.
    'Add keys and items to the Dictionary
    For Iter = 1 To (LastCol - 1) Step 2
        Dict.Add Cells(1, Iter).Value, Cells(1, Iter + 1).Value
    Next Iter
    '''''''''''''''''BK201's Mod'''''''''''''''''

    'Allocate storage space for the dynamic array
    ReDim Arr(0 To Dict.Count - 1, 0 To 1)

    'Fill the array with the keys and items from the Dictionary
    For i = 0 To Dict.Count - 1
        Arr(i, 0) = Dict.Keys(i)
        Arr(i, 1) = Dict.Items(i)
    Next i

    'Sort the array using the bubble sort method
    For i = LBound(Arr, 1) To UBound(Arr, 1) - 1
        For j = i + 1 To UBound(Arr, 1)
            If Arr(i, 1) < Arr(j, 1) Then
                Temp1 = Arr(j, 0)
                Temp2 = Arr(j, 1)
                Arr(j, 0) = Arr(i, 0)
                Arr(j, 1) = Arr(i, 1)
                Arr(i, 0) = Temp1
                Arr(i, 1) = Temp2
            End If
        Next j
    Next i

    'Clear the Dictionary
    Dict.RemoveAll

    'Add the sorted keys and items from the array back to the Dictionary
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        Dict.Add Key:=Arr(i, 0), Item:=Arr(i, 1)
    Next i

    '''''''''''''''''BK201's Mod'''''''''''''''''
    'Change Cells(2, Iter2) to Cells(1, Iter2) to overwrite.
    KeyIndex = 0
    For Iter2 = 1 To (LastCol - 1) Step 2
        Cells(2, Iter2).Value = Dict.Keys(KeyIndex)
        KeyIndex = KeyIndex + 1
    Next Iter2

    For Iter3 = 2 To LastCol Step 2
        Cells(2, Iter3).Value = Dict.Item(Cells(2, Iter3 - 1).Value)
    Next Iter3
    '''''''''''''''''BK201's Mod'''''''''''''''''

    Set Dict = Nothing

End Sub

<强>截图：

<强> 设置：

enter image description here

运行代码后的结果：

enter image description here

相应地修改所涉及的范围。如果这有帮助，请告诉我们。

水平排序的配对条目

3 个答案: