Как удалить пустую всю строку, если ячейка под определенным именем столбца пуста? - PullRequest
1 голос
/ 04 июля 2019

Мне нужно импортировать несколько xml-файлов в Excel, и мне нужно выровнять имена столбцов для всех xml-таблиц, которые вставляются в Excel.Проблема в том, что некоторые из xml-файлов содержат один дополнительный столбец, который мне не нужен.Этот столбец появляется в середине таблицы, что затрудняет работу с данными.Кроме того, мне нужно удалить всю строку, если ячейки с именем «содержимое» пустые.

Пока мне удалось создать командную кнопку, которая импортирует xml-файлы в Excel (см. Код).

Sub CommandButton1_Click()    
    Dim xWb As Workbook
    Dim xSWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xSWb = ThisWorkbook
    xCount = 1
    xFile = Dir(xStrPath & "\*.xml")
    Do While xFile <> ""
        Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
        xWb.Sheets(1).UsedRange.Copy xSWb.Sheets(1).Cells(xCount, 1)
        xWb.Close False
        xCount = xSWb.Sheets(1).UsedRange.Rows.Count + 2
        xFile = Dir()
    Loop
    Application.ScreenUpdating = True
    xSWb.Save
    Exit Sub

ErrHandler:
    MsgBox "no files xml", , "Kutools for Excel"
End Sub

Я надеюсь получить 30 таблиц из 30 xml-файлов с одинаковыми заголовками в тех же столбцах.Кроме того, мне нужно удалить пустые ячейки, о которых я говорил, поскольку наборы данных несколько огромны.

Ответы [ 2 ]

0 голосов
/ 04 июля 2019

Это может помочь вам:

Option Explicit

Sub test()

    Dim ColumnName As String
    Dim LastColumn As Long, LastRow As Long
    Dim rngFoundContent As Range
    Dim rngFoundColumn As Range

    'Change sheet name if needed
    With ThisWorkbook.Worksheets("Sheet1")

        'Search for the word "Content"
        Set rngFoundContent = .UsedRange.Find("Content", LookIn:=xlValues)
        'If "Content" found
        If Not rngFoundContent Is Nothing Then
            'Delete the row below
            .Rows(rngFoundContent.Row + 1).EntireRow.Delete
        End If

        'Search for the Column Name (Lest us assume that column name is "Test"0
        ColumnName = "Test"
        'Let us assume that Headers appear in row 1, find the last column of row 1
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'Search for the word column Test
        Set rngFoundColumn = .Range(.Cells(1, 1), .Cells(1, LastColumn)).Find(ColumnName, LookIn:=xlValues)
        'If column found
        If Not rngFoundColumn Is Nothing Then
            'Delete whole column
            .Columns(rngFoundColumn.Column).EntireColumn.Delete
        End If

    End With

End Sub
0 голосов
/ 04 июля 2019

Попробуйте найти этот дополнительный столбец, используя, например, Instr () в строке заголовка открытой книги - только если вы знаете имя заголовка этого столбца. Сделайте это в рабочей книге xWb и после исправлений скопируйте вставку в основную рабочую книгу. Обращаясь к операции удаления пустых ячеек, Вы можете сделать это после вставки в основной файл. Просто выполните простую инструкцию if (), проверяя, пуста ли ячейка в указанном столбце - "" (двойные кавычки). Вы можете поместить это if () в цикл от 2 до последней строки - эту последнюю строку. Вы можете «измерить» в xWb, используя xWb.cells (rows.count, 1) .end (xlup) .Row. Дайте мне знак, если вам удалось что-то сделать.

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