在Excel 2013中更改列内容的顺序

时间:2016-07-15 12:46:59

标签: excel excel-vba vba

我有兴趣通过某个规则更改Excel中表格列内容的顺序,以这种方式重新排序整个表格。 我将在这里发布一个例子,以便您理解。

假设您在表格中有这一栏:

Column
 A
 B
 C
 B
 C
 A
 A
 B
 C

我想让它看起来像这样:

 Column
   A
   B
   C
   A
   B
   C
   A
   B
   C

这可能吗?

1 个答案:

答案 0 :(得分:0)

尝试使用吹码。

注意:我使用了Sheet8

Sub orderchange()
    Dim lastcolumn, i, keyval As Long
    Dim fixit As String
    lastcolumn = Sheets("Sheet8").Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To lastcolumn Step 3
        If Sheets("Sheet8").Cells(1, i) = "A" And Sheets("Sheet8").Cells(1, i + 1) = "B" And Sheets("Sheet8").Cells(1, i + 2) = "C" Then
            'nothing
        Else
            If Sheets("Sheet8").Cells(1, i) <> "A" And Sheets("Sheet8").Cells(1, i + 1) = "A" Then
                fixit = Sheets("Sheet8").Cells(1, i)
                Sheets("Sheet8").Cells(1, i) = Sheets("Sheet8").Cells(1, i + 1)
                Sheets("Sheet8").Cells(1, i + 1) = fixit
            ElseIf Sheets("Sheet8").Cells(1, i) <> "A" And Sheets("Sheet8").Cells(1, i + 2) = "A" Then
                fixit = Sheets("Sheet8").Cells(1, i)
                Sheets("Sheet8").Cells(1, i) = Sheets("Sheet8").Cells(1, i + 2)
                Sheets("Sheet8").Cells(1, i + 2) = fixit
            End If

            If Sheets("Sheet8").Cells(1, i + 1) <> "B" And Sheets("Sheet8").Cells(1, i + 2) = "B" Then
                fixit = Sheets("Sheet8").Cells(1, i + 1)
                Sheets("Sheet8").Cells(1, i + 1) = Sheets("Sheet8").Cells(1, i + 2)
                Sheets("Sheet8").Cells(1, i + 2) = fixit
            ElseIf Sheets("Sheet8").Cells(1, i + 1) <> "B" And Sheets("Sheet8").Cells(1, i) = "B" Then
                fixit = Sheets("Sheet8").Cells(1, i + 1)
                Sheets("Sheet8").Cells(1, i + 1) = Sheets("Sheet8").Cells(1, i)
                Sheets("Sheet8").Cells(1, i) = fixit
            End If

            If Sheets("Sheet8").Cells(1, i + 2) <> "C" And Sheets("Sheet8").Cells(1, i) = "C" Then
                fixit = Sheets("Sheet8").Cells(1, i + 2)
                Sheets("Sheet8").Cells(1, i + 2) = Sheets("Sheet8").Cells(1, i)
                Sheets("Sheet8").Cells(1, i) = fixit
            ElseIf Sheets("Sheet8").Cells(1, i + 2) <> "C" And Sheets("Sheet8").Cells(1, i + 1) = "C" Then
                fixit = Sheets("Sheet8").Cells(1, i + 2)
                Sheets("Sheet8").Cells(1, i + 2) = Sheets("Sheet8").Cells(1, i + 1)
                Sheets("Sheet8").Cells(1, i + 1) = fixit
            End If
        End If
    Next i
End Sub

工作证明

enter image description here