Excel:按行内容对列进行sorting

很难形容。

我有一些专栏,说三:

10 20 20

20 22 24

24 24 26

我喜欢得到的是:

10 XX XX

20 20 20

XX 22 XX

24 24 24

XX XX 26

其中XX是一个空单元格。

有没有办法得到这个?

再见,托马斯

你可以用ADO做很多事情。

Dim cn As Object Dim rs As Object Dim strFile As String Dim strCon As String Dim strSQL As String Dim s As String Dim i As Integer, j As Integer ''This is not the best way to refer to the workbook ''you want, but it is very convenient for notes ''It is probably best to use the name of the workbook. strFile = ActiveWorkbook.FullName ''Note that if HDR=No, F1,F2 etc are used for column names, ''if HDR=Yes, the names in the first row of the range ''can be used. ''This is the Jet 4 connection string, you can get more ''here : http://www.connectionstrings.com/excel strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";" ''Late binding, so no reference is needed Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") cn.Open strCon strSQL = "SELECT 1 As Col, F1 As Cont FROM [Sheet1$] " _ & "UNION ALL SELECT 2 As Col, F2 As Cont FROM [Sheet1$] " _ & "UNION ALL SELECT 3 As Col, F3 As Cont FROM [Sheet1$] " _ & "ORDER BY Cont" rs.Open strSQL, cn, 3, 3 ''Pick a suitable empty worksheet for the results With Worksheets("Sheet2") ''Working with the recordset ... Do While Not rs.EOF If rs("Cont") > j Then i = i + 1 j = rs("Cont") .Cells(i, rs("Col")) = rs("Cont") rs.MoveNext Loop End With 

这个VBA脚本可以满足你的需求。 您将需要添加对脚本运行时的引用(工具 – >引用)。 只需将脚本分配给一个button或将其保存为一个macros。 当你按下它将使用你当前select的单元格。

 Private Sub CommandButton2_Click() Dim dict As New Scripting.Dictionary ReDim isInColumn(1 To Selection.Columns.Count) As Integer Dim max As Integer Dim min As Integer Dim row As Integer min = Selection.Cells(1, 1).Value For Each cell In Selection If cell.Value < min Then min = cell.Value If cell.Value > max Then max = cell.Value If Not dict.Exists(cell.Value) Then dict.Add cell.Value, isInColumn End If tempArray = dict(cell.Value) tempArray(cell.Column + 1 - Selection.Column) = 1 dict(cell.Value) = tempArray Next For i = min To max If dict.Exists(i) Then tempArray = dict(i) For t = LBound(tempArray) To UBound(tempArray) If tempArray(t) = 1 Then Selection.Cells(1, 1).Offset(row, t - 1) = i Else Selection.Cells(1, 1).Offset(row, t - 1) = "xx" End If Next t row = row + 1 End If Next i End Sub