根据使用VBScript的条件，在单个行中合并多个行 [英] Merge multiple rows in a single row depending on conditions using VBScript

问题描述

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

  EmpId Empname EmpAddrs Hiredate joineddate工资类型OfWorker BondOver CurrentBU报告人员经理
 11 abc eee 12/10 01/11 20KP是ALP MM PMO 
 12 abc tpt 10/10 01/11 10KT无ATP MM PMO 
 82 abc tpp 08 / 10 01/11 10KT无ATP MM OOP 
 72 abc tpp 08/10 01/11 10KP无ATT MM OOP 
  

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

  Manager EmpId Hiredate TypeOfWorker CurrentBU报告人员EmpId Hiredate TypeOfWorker CurrentBU rep orting officer 
 PMO 11 12/10PALP MM 12 10/10TATP MM 
 OOP 82 08/10TATP MM 82 08/10PATT MM 
  

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

谢谢

解决方案

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

 设置xl = CreateObject （Excel.Application）
设置wb = xl.Workbooks.Openbefore.xlsx
 
'删除列，从最右边的列开始，以避免调整
 'position 
 wb.Sheets（1）.Columns（H：H）。删除
 wb.Sheets（1）.Columns（F：F）。删除
'。 .. 
 
 wb.SaveAsbefore.csv，6 
 wb.Close False'b / c文件未保存为Excel格式
 xl.Quit 
  

然后将其转换为：

  infile =before.csv
 outfile =after.csv
 
设置fso = CreateObject（Scripting.FileSystemObject）
 
设置f = fso.OpenTextFile（infile）
 
 heading = f.ReadLine 
 data = f.ReadLine 
 
直到f.AtEndOfStre am 
 heading = heading& ，&标题
 data = data& ，& f.Readline 
循环
 
 f.Close 
 
设置f = fso.OpenTextFile（outfile，2）
 f.WriteLine标题
 f.WriteLine data 
 f.Close 
  

然后在Excel中打开新的CSV并保存作为工作簿：

 设置xl = CreateObject（Excel.Application）
 
 numCols =。 .. 
 
 dataTypes = Array（）
对于i = 0到numCols 
 ReDim保留dataTypes（UBound（dataTypes））
 dataTypes（UBound（dataTypes）） = Array（i + 1，2）
下一个
 
设置wb = xl.Workbooks.OpenTextafter.csv，，，1，False，False，True，_ 
，，，dataTypes 
 wb.SaveAsafter.xlsx
 wb.Close 
 
 xl.Quit 
  pre> 
 
 
当然，这三个步骤可以组合成一个脚本，但是我将把它作为读者的练习。
 
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
解决方案
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.

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