I want to change the names of the columns in an Excel sheet.
I want to rename the column headers as in the image.
答案 0 :(得分:0)
You don't say if there is more than one area with these headers, so my solution will work for several. Unfortunately it will work for a maximum of 26 columns, one for each letter of the alphabet. You can expand it if you want. I've included workbook and worksheet names, these are particular to me, you'll obviously have to change them. The code looks for areas of data and steps through them, changing the headers on each one. You can adapt the code to just do one area of course. The code starts in the top left of the area, and steps across one cell at a time until it runs out of data, then it moves onto the next area.
Sub NewColumnNames()
Dim FruityColumnNames(26) As String
Dim a As Integer
Dim Alphabetical As Integer
FruityColumnNames(1) = "Apple"
FruityColumnNames(2) = "Banana"
FruityColumnNames(3) = "Cherry"
FruityColumnNames(4) = "Damson"
FruityColumnNames(5) = "Elderberry"
FruityColumnNames(6) = "Fig"
FruityColumnNames(7) = "Gooseberry"
FruityColumnNames(8) = "Hawthorn"
FruityColumnNames(9) = "Ita palm"
FruityColumnNames(10) = "Jujube"
FruityColumnNames(11) = "Kiwi"
FruityColumnNames(12) = "Lime"
FruityColumnNames(13) = "Mango"
FruityColumnNames(14) = "Nectarine"
FruityColumnNames(15) = "Orange"
FruityColumnNames(16) = "Passion fruit"
FruityColumnNames(17) = "Quince"
FruityColumnNames(18) = "Raspberry"
FruityColumnNames(19) = "Sloe"
FruityColumnNames(20) = "Tangerine"
FruityColumnNames(21) = "Ugli"
FruityColumnNames(22) = "Vanilla"
FruityColumnNames(23) = "Watermelon"
FruityColumnNames(24) = "Xigua"
FruityColumnNames(25) = "Yumberry"
FruityColumnNames(26) = "Zucchini"
With Workbooks("TestBook.xlsx")
With .Worksheets("Destination")
With .UsedRange.SpecialCells(xlCellTypeConstants)
For a = .Areas.Count To 1 Step -1
Alphabetical = 1
With .Areas(a)
While (.Cells(1, Alphabetical) <> "" And Alphabetical <= 26)
.Cells(1, Alphabetical).Value = FruityColumnNames(Alphabetical)
Alphabetical = Alphabetical + 1
Wend
End With
Next a
End With
End With
End With
End Sub
答案 1 :(得分:0)
示例呼叫 (代码减少):
Sub ChangeHeaderNames()
Dim headers: headers = Split("Apple,Banana,Cherry", ",")
Sheet1.Range("A1").Resize(1, UBound(headers) + 1) = headers ' << change to sheet's Code(Name)
End Sub