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

后端 未结 1 795
傲寒
傲寒 2020-12-04 03:56

Suppose, I have An Excel Matrix like below :

  EmpId   Empname   EmpAddrs    Hiredate    joiningdate   Salary   TypeOfWorker    BondOver   CurrentBU    repor         


        
相关标签:
1条回答
  • 2020-12-04 04:55

    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.

    0 讨论(0)
提交回复
热议问题