Как удалить столбцы из файла 1, которого нет в файле 2, используя VBScript? - PullRequest
0 голосов
/ 28 июня 2019

Файл 1 имеет - Дата, Время, Часовая зона, CustomerFirstName, CustomerLastName, CustomerAddress, PhoneNumber, Страна, Продукт, OrderNumber, CreationDate, BatchNumber

Файл 2 имеет - Дата, Время, TimeZone, Страна, OrderNumber,BatchNumber

Удалить столбцы из File1, которых нет в File2.Я хочу сделать программный так, чтобы, если Файл 2 изменяется с большим количеством столбцов, тот же код работал.Примечание. Список столбцов файла 2 всегда является подмножеством файла 1.

Попытка сравнить два файла Excel.

Вот мой код с комментариями

Sub deleteIrrelevantColumns(strXl, strXlTemplate)
    Dim currentColumn
    Dim newCurrCol
    Dim colTemplate
    Dim colXlCount

    Set objExcel = CreateObject("Excel.Application")
    Set objXl = objExcel.Workbooks.Open(strXl)
    Set objXlTemplate = objExcel.Workbooks.Open(strXlTemplate)
    Set objXlTemplateWS =  objXlTemplate.Sheets(1)
    Set objXlWS = objXl.Sheets(1)
    objXlWS.Cells.EntireColumn.AutoFit
    objXlTemplateWS.Cells.EntireColumn.AutoFit

    objExcel.DisplayAlerts = False
    objExcel.ScreenUpdating = False

    colXlCount = objXlWS.UsedRange.Columns.Count 
    colTemplateCount = objXlTemplateWS.UsedRange.Columns.Count
    currentColumn = 1

    'Create an array of the size equal to column count
    ReDim columnHeading(colXlCount)

    'Copy the Column heading from Excel file to an array
    For i  = 0 To Ubound(columnHeading)
        columnHeading(i) = objXlWS.UsedRange.Cells(1, currentColumn).Value
        currentColumn = currentColumn + 1       
    Next
    'Logic to compare and remove columns
End Sub

1 Ответ

0 голосов
/ 29 июня 2019

Я изменил часть вашего исходного кода и добавил комментарий. Я также добавил логику, как сравнивать и удалять столбцы, которых нет в вашем шаблоне. Я уверен, что есть лучший способ сделать это, но я запрограммировал способ для легкого понимания.

Надеюсь, это поможет.

Dim currentColumn
Dim newCurrCol
Dim colTemplate
Dim colXlCount
Dim strXl           As String
Dim strXlTemplate   As String

Set objExcel = CreateObject("Excel.Application")
Set objxl = objExcel.Workbooks.Open(strXl)
Set objXlTemplate = objExcel.Workbooks.Open(strXlTemplate)
Set objXlTemplateWS = objXlTemplate.Sheets(1)
Set objxlws = objxl.Sheets(1)
objxlws.Cells.EntireColumn.AutoFit
objXlTemplateWS.Cells.EntireColumn.AutoFit
objExcel.DisplayAlerts = False
objExcel.ScreenUpdating = False

colXlCount = objxlws.UsedRange.Columns.Count
colTemplateCount = objXlTemplateWS.UsedRange.Columns.Count

currentColumn = 1

'Create an array of the size equal to column count
'Note: Changed ReDim columnHeading(colXlCount) to ReDim columnHeading(colTemplateCount-1) _
I want to say you should save the Template Column Name into array so you can compare to the ActiveWorkBook

ReDim columnheading(colTemplateCount - 1)

'Copy the Column heading from Excel file to an array
For i = 0 To UBound(columnheading)
    columnheading(i) = objXlTemplateWS.UsedRange.Cells(1, currentColumn).Value
    currentColumn = currentColumn + 1
Next
'Logic to compare and remove columns

Dim IntCol      As Integer  'for Column reference
Dim EndCol      As Integer  'Last Column Number Reference
Dim BlnDel      As Boolean  'Indicator for whether should a column be deleted.

EndCol = objxlws.Cells(1, Columns.Count).End(xlToLeft).Column
For IntCol = EndCol To 1 Step -1

    BlnDel = True 'set default in the beginning of the loop

    For i = 0 To UBound(columnheading)
        If objxlws.Cells(1, IntCol) = columnheading(i) Then
            BlnDel = False      ' Set to False for any match column to avoid being deleted.
        End If
    Next
        If BlnDel Then
            'objxlws.Columns(IntCol).Delete                      'For Real
            Debug.Print objxlws.Cells(1, IntCol) & " Delete"     'For Test
        End If
Next

objxl.Close
objXlTemplate.Close
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...