Question

假设我有一个如下所示的Excel矩阵：

  EmpId   Empname   EmpAddrs    Hiredate    joiningdate   Salary   TypeOfWorker    BondOver   CurrentBU    reporting officer     Manager
    11      abc       eee        12/10          01/11       20K         "P"          Yes         ALP            MM                 PMO
    12      abc       tpt        10/10          01/11       10K         "T"           No         ATP            MM                 PMO
    82      abc       tpp        08/10          01/11       10K         "T"           No         ATP            MM                 OOP
    72      abc       tpp        08/10          01/11       10K         "P"           No         ATT            MM                 OOP

我需要将它们全部合并如下：

 Manager   EmpId   Hiredate    TypeOfWorker    CurrentBU    reporting officer   EmpId   Hiredate    TypeOfWorker    CurrentBU    reporting officer
   PMO       11     12/10         "P"            ALP             MM               12     10/10          "T"           ATP             MM
   OOP       82     08/10         "T"            ATP             MM               82     08/10          "P"           ATT             MM

任何实现相同的想法？拥有相同经理的所有员工将在一行中具有有限的列值。

由于

Answer 1

删除不需要的列并将表格导出为CSV：

Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open "before.xlsx"

' delete columns, start with the rightmost column to avoid having to adjust
' positions
wb.Sheets(1).Columns("H:H").Delete
wb.Sheets(1).Columns("F:F").Delete
'...

wb.SaveAs "before.csv", 6
wb.Close False   ' b/c the file wasn't saved in Excel format
xl.Quit

然后将其转换为：

infile  = "before.csv"
outfile = "after.csv"

Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.OpenTextFile(infile)

heading = f.ReadLine
data    = f.ReadLine

Do Until f.AtEndOfStream
  heading = heading & "," & heading
  data    = data & "," & f.Readline
Loop

f.Close

Set f = fso.OpenTextFile(outfile, 2)
f.WriteLine heading
f.WriteLine data
f.Close

然后在Excel中打开新CSV并将其另存为工作簿：

Set xl = CreateObject("Excel.Application")

numCols = ...    ' 

dataTypes = Array()
For i = 0 To numCols
  ReDim Preserve dataTypes(UBound(dataTypes))
  dataTypes(UBound(dataTypes)) = Array(i+1, 2)
Next

Set wb = xl.Workbooks.OpenText "after.csv", , , 1, 1, False, False, True, _
  , , , dataTypes
wb.SaveAs "after.xlsx"
wb.Close

xl.Quit

当然这三个步骤可以组合成一个单独的脚本，但我将把它作为读者的练习。

根据使用VBScript的条件，在一行中合并多行

1 个答案: