通过vbscript转置Excel

时间:2012-06-21 13:55:24

标签: excel vbscript transpose

我有一个Excel电子表格,我已从其他程序中导出。

它的行根据几个商业条件着色。

现在我必须将整个Excel工作表与颜色和格式一起转置。

请注意,我必须仅使用Vbscript执行此操作。

这是我到目前为止编写的代码,但是这种转换没有格式化:

 sub transpose
 On Error Resume Next
 Set objExcel = CreateObject("Excel.Application")
 objExcel.Visible = False
 objExcel.Workbooks.Add()
 set table = ActiveDocument.GetSheetObject( "CH01" )
 CellRect = ActiveDocument.GetApplication().GetEmptyRect()
 CellRect.Top = 0
 CellRect.Left = 0
 CellRect.Width = table.GetColumnCount
 CellRect.Height = table.GetRowCount
 set CellMatrix = table.GetCells( CellRect )
 for RowIter=CellRect.Top to CellRect.Width-1
   for ColIter=CellRect.Left to CellRect.Height-1
     ObjExcel.Cells(RowIter+1, ColIter+1).Value = CellMatrix(ColIter)(RowIter).Text
    'msgbox(CellMatrix(ColIter)(RowIter).Text)
   next
 next
 objExcel.ActiveWorkbook.SaveAs("C:\Documents and    Settings\prasanna\Desktop\test3.xls")
 objExcel.Application.Workbooks.Open("C:\Documents and           Settings\prasanna\Desktop\test3.xls")
 objExcel.Application.Visible = True
 objExcel = Nothing
 end sub

1 个答案:

答案 0 :(得分:0)

Phew ..,这耗费了一些时间并进行了试验,这是2012年办公室的可行解决方案

const xlPasteValuesAndNumberFormats = 12 'doesn't work with Excel 2010 ?
const xlFormats =-4122
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = false

如果您已经拥有目标xls,则可以跳过这些行

Set wbkDest = objExcel.Workbooks.Add
wbkDest.saveAs "c:\test2.xls"
wbkDest.close

继续这里

Set objWorkbook1= objExcel.Workbooks.Open("C:\test1.xls")
Set objWorkbook2= objExcel.Workbooks.Open("C:\test2.xls")
objWorkbook1.Worksheets("Sheet1").UsedRange.Copy
'we have to do the paste twice, once for the values, once for the formats
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial xlFormats
objWorkbook1.save
objWorkbook2.save
objWorkbook1.close
objWorkbook2.close
set objExcel=nothing