- ©«¤l
- 4
- ¥DÃD
- 1
- ºëµØ
- 0
- ¿n¤À
- 8
- ÂI¦W
- 0
- §@·~¨t²Î
- XP
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 10
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-10-22
- ³Ì«áµn¿ý
- 2017-10-5
|
§Ú¥un§â¸ê®Æ·h²¾¨ìBÀɪºÄæ¦ì¡A¦Ó¤£¬On·h²¾·sªºÀɮסA¦³½Ö¥i¥H±Ð§Ú×§ï¡H
Sub TEST()
Dim ar, r As Long, i As Long
Dim cIndexOld, cIndexNew, arNewHeader
Dim f
cIndexOld = Array(4, 5) 'AÀɮפ¤n·h°ÊªºÄæ
cIndexNew = Array(4, 5) '·h¨ìBÀɦì¸m(Äæ¸¹)
arNewHeader = Array("·s¤áÄy¦a§}", "·s³q°T¦a§}") 'BÀɼÐÃD¦WºÙ
f = Application.GetOpenFilename(FileFilter:="Excel ¬¡¶Ã¯ (*.xls),*.xls", Title:="¿ï¾Ü¨Ó·½ÀÉ®×")
If Not TypeName(f) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
Application.ScreenUpdating = False
With Workbooks.Open(f)
With .Sheets(1)
ar = .Range("A2:E" & .[A2].CurrentRegion.Rows.Count).Value
End With
.Close False
End With
Application.ScreenUpdating = True
r = UBound(ar)
With Workbooks.Add
With .Sheets(1)
For i = LBound(cIndexOld) To UBound(cIndexOld)
.Cells(1, cIndexNew(i)).Resize(r).Value = Application.WorksheetFunction.Index(ar, 0, cIndexOld(i))
.Cells(1, cIndexNew(i)).Value = arNewHeader(i)
Next
End With
End With
End Sub |
|