使用 VBScript 根据条件将多行合并为一行 [英] Merge multiple rows in a single row depending on conditions using VBScript

问题描述

假设，我有一个像下面这样的 Excel 矩阵:

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.

谢谢

推荐答案

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

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

然后像这样转换:

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 并将其另存为工作簿:

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.

这篇关于使用 VBScript 根据条件将多行合并为一行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！