尝试使用Excel宏添加列时出错

时间:2013-11-05 19:27:38

标签: excel excel-vba vba

我正在运行一个基本的Transpose和Concatenate宏。

在输入选项卡上输入数据,运行宏,数据显示在输出选项卡上。

问题在于,输入选项卡上的其中一列未设置为在输出选项卡上显示。这个需要的列是E列。

我已将其添加到宏中,但它显示错误。当我点击Debug时,下面第30行上的单词Apply会突出显示为错误,但是,我看不出错误是怎么回事。

这是宏:

Sub TransposeConcatinate()
Dim i As Integer, toprow As Integer, lastrow As Integer

Application.ScreenUpdating = False

'Copy data from the pastehere sheet to the output sheet

    Sheets("Output").Cells.Delete
    Sheets("PasteHere").Columns("A:E").Copy Sheets("Output").Columns("A:E")
    Sheets("Output").Select

'Sort the columns
    ActiveWorkbook.Worksheets("Output").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("A:A" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("B:B" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("C:C" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("D:D" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("D:E" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Output").Sort
        .SetRange Range("A:E")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


'Count the number of rows
    With Sheets("Output")
        lastrow = .Range("A" & Rows.Count).End(xlUp).Row
    End With

    toprow = 2

'Insert a column, make it a combination of ID and Price Schedule for use as a unique ID
    Columns("C:C").Insert

    For i = 2 To lastrow Step 1
        Cells(i, 3) = Cells(i, 1) & Cells(i, 2)
    Next


'Do the concatination and transposing
    For i = 2 To lastrow Step 1
        If Cells(i, 3) <> Cells(i - 1, 3) Then
            toprow = i
            Cells(i, 6) = Cells(i, 4)
            Cells(i, 7) = Cells(i, 5)
        End If
        If Cells(i, 3) = Cells(i - 1, 3) Then
            If toprow = i Then
                Cells(i, 6) = Cells(i, 4)
                Cells(i, 7) = Cells(i, 5)
            Else
                Cells(toprow, 6).Value = Cells(toprow, 6).Value & ";" & Cells(i, 4).Value
                Cells(toprow, 7).Value = Cells(toprow, 7).Value & ";" & Cells(i, 5).Value
            End If
        End If
    Next

'Remove extra column
    Columns("C:C").Delete

'Title new columns
    Cells(1, 5).Value = "Concatinated Quantities"
    Cells(1, 6).Value = "Concatinated Prices"
    Rows("1:1").Font.Bold = True

'Remove unneeded rows
    For i = lastrow To 2 Step -1
        If Cells(i, 5) = "" Then
            Rows(i).Delete
        End If
    Next

'Remove unneeded columns and format
    Columns("C:D").Delete
    Columns("A:A").ColumnWidth = 8
    Columns("B:B").ColumnWidth = 29
    Columns("C:D").ColumnWidth = 25
    Rows("1:1").RowHeight = 15


Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:1)

如果您查看实际错误,则表示您的排序参考无效,这意味着您的排序条件(您的密钥无效)。

您的最后一个键为RANGE(“D:E”),您需要将其更改为RANGE(“E:E”)。您只能将一列作为排序中的键。