Classificando duas colunas não adjacentes sem afetar nenhuma outra coluna

Question

Eu tenho duas colunas diferentes no Excel. Eu quero criar um script que irá classificar a coluna F, (ter um cabeçalho) e irá classificar a coluna B com base em onde o tipo da coluna F funcionou. (Sem afetar outras colunas, no entanto!)

Então, se eu tiver

    ColB       ColF
 1. Cat        2
 2. Mouse      1
 3. Dog        3

O tipo me dará

    ColB       ColF
 1. Mouse        1
 2. Cat          2
 3. Dog          3

Como posso fazer isso? Tentei gravar uma macro, (ou simplesmente tentar classificá-la com as duas colunas clicadas e o botão de classificação), mas recebo um erro dizendo "O comando não pode ser executado com várias seleções, clique em um único intervalo e tente novamente "

    

Answer 1

Eu suspeito que deve haver uma maneira melhor de realizar o que você deseja fazer classificando essas colunas, mas aqui está uma solução do VBA que fará exatamente o que você pediu. Cuidado com este código assume que não há células em branco nos intervalos que você deseja classificar. Por favor, deixe um comentário se isso for um problema, porque será muito fácil de corrigir.

Sub nonadjacentsort()
Dim rng1 As Range, rng2 As Range, rngTmp As Range, s1 As Worksheet, tmpS As Worksheet
Dim tmpArr1() As Variant, tmpArr2() As Variant
Dim i As Long
Set s1 = ActiveSheet
'Set Ranges to sort.  This assumes there are no blanks in your data.
Set rng1 = s1.Range("B1", Range("B1").End(xlDown))
Set rng2 = s1.Range("F1", Range("F1").End(xlDown))
'Load first column into temporary array
tmpArr1 = rng1.Value
'Load data into larger array that will hold both columns
ReDim tmpArr2(1 To UBound(tmpArr1, 1), 1 To 2) As Variant
For i = 1 To UBound(tmpArr1, 1)
    tmpArr2(i, 1) = tmpArr1(i, 1)
Next i
'Load second column into temporary array
Erase tmpArr1
tmpArr1 = rng2.Value
'Load second column into larger array
For i = 1 To UBound(tmpArr1, 1)
    tmpArr2(i, 2) = tmpArr1(i, 1)
Next i
Erase tmpArr1
'Add new sheet and print two columns there together.
Application.ScreenUpdating = False
Set tmpS = Sheets.Add
Set rngTmp = tmpS.Range("A1").Resize(UBound(tmpArr2, 1), 2)
rngTmp = tmpArr2
Erase tmpArr2
'Sort by second column (Column F of original data)
rngTmp.Sort rngTmp.Cells(1, 2), xlAscending, Header:=xlYes
'Load sorted data into array and then overwrite columns on original data
tmpArr1 = rngTmp.Columns(1).Value
rng1 = tmpArr1
Erase tmpArr1
tmpArr1 = rngTmp.Columns(2).Value
rng2 = tmpArr1
Erase tmpArr1
'Delete temporary sheet.
Application.DisplayAlerts = False
tmpS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub