Merge multiple rows in a single row depending on conditions using VBScript

问题

Suppose, I have An Excel Matrix like below :

  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

I Need to merge them all as below:

 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

Any Idea to implement the same? All employees having the same manager will be in one row with limited column values.

Thanks

回答1:

Remove the columns you don't need and export the table as 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

Then convert it like this:

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

Then open the new CSV in Excel and save it as a workbook:

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

Of course these three steps can be combined into a single script, but I'm going to leave that as an exercise for the reader.

来源：https://stackoverflow.com/questions/13947199/merge-multiple-rows-in-a-single-row-depending-on-conditions-using-vbscript

标签

powershell

excel-vba

vbscript

adodb

vba