Excel - VBA - 重新排序/重命名列

时间:2013-08-14 11:56:56

标签: excel vba

我正在尝试使用Excel中的VB创建宏来重新排序/重命名电子表格中的列。

除了重新排序列之外,我还希望更改列标题的标题。

例如:'partner_accountname' - > '用户名'     'partner_no' - > “partner_number              ......等等

我一直在使用以下代码重新排序列(工作正常)但我不知道如何重命名列标题:


Sub MoveColumns()

' MoveColumns Macro
'
' Developer: Winko Erades van den Berg
' E-mail : winko@winko-erades.nl
' Developed: 03-10-2011
' Modified: 03-10-2011
' Version: 1.0
'
' Description: Rearrange columns in Excel based on column header

Dim iRow As Long
Dim iCol As Long

'Constant values
data_sheet1 = InputBox("Specify the name of the Sheet that needs to be reorganised:") 'Create Input Box to ask the user which sheet needs to be reorganised
target_sheet = "Final Report" 'Specify the sheet to store the results
iRow = Sheets(data_sheet1).UsedRange.Rows.Count 'Determine how many rows are in use

'Create a new sheet to store the results
Worksheets.Add.Name = "Final Report"

'Start organizing columns
For iCol = 1 To Sheets(data_sheet1).UsedRange.Columns.Count

    'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns
    TargetCol = 0

    'Read the header of the original sheet to determine the column order
    If Sheets(data_sheet1).Cells(1, iCol).Value = "billing_country" Then TargetCol = 7
    If Sheets(data_sheet1).Cells(1, iCol).Value = "partner_accountname" Then TargetCol = 2
    If Sheets(data_sheet1).Cells(1, iCol).Value = "partner_number" Then TargetCol = 3
    If Sheets(data_sheet1).Cells(1, iCol).Value = "pbl_due_date" Then TargetCol = 4
    If Sheets(data_sheet1).Cells(1, iCol).Value = "total_amount" Then TargetCol = 5
    If Sheets(data_sheet1).Cells(1, iCol).Value = "pb_payment_currency" Then TargetCol = 6
    If Sheets(data_sheet1).Cells(1, iCol).Value = "sort_code" Then TargetCol = 1
    If Sheets(data_sheet1).Cells(1, iCol).Value = "cda_number" Then TargetCol = 8

    'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot
    If TargetCol <> 0 Then
        'Select the column and copy it
        Sheets(data_sheet1).Range(Sheets(data_sheet1).Cells(1, iCol), Sheets(data_sheet1).Cells(iRow, iCol)).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
    End If

Next iCol 'Move to the next column until all columns are read

End Sub

你能帮我解决这个问题吗?

谢谢, 夏兰

1 个答案:

答案 0 :(得分:2)

我发现将表单上的数据转换为表格会使编程变得更好,而且不那么混乱。如果您将数据转换为名为“TableName”的表并希望将某个列#(本例中为2)重命名为“Column Title”,则这将是代码。

Dim columnNumber As Long
Dim myTab As ListObject
Set myTab = ActiveSheet.ListObjects("TableName")
columnNumber = 2
myTab.HeaderRowRange(1, columnNumber) = "Column Title"

要为多个列运行此操作,只需通过for循环运行它:

Dim columnNumber As Long
Dim myTab As ListObject
Set myTab = ActiveSheet.ListObjects("TableName")

For x = 1 To 10  ' For Columns 1 through 10
    columnNumber = x
    myTab.HeaderRowRange(1, columnNumber) = "Column Title"
Next x