Удаление пустых столбцов / строк в VBA как часть сохранения csv - PullRequest
Новая
       8

Удаление пустых столбцов / строк в VBA как часть сохранения csv

0 голосов
/ 13 января 2019

Я использую следующий код VBA для сохранения каждого отдельного листа в книге .xlsx в файл .csv.

Пока код работает хорошо, я хотел бы адаптировать код VBA, чтобы пустые столбцы и строки удалялись из создаваемых CSV-файлов.

Существующий код VBA: 

Public Sub SaveWorksheetsAsCsv()
   Dim xWs As Worksheet
   Dim xDir As String
   Dim folder As FileDialog
   Set folder = Application.FileDialog(msoFileDialogFolderPicker)
   If folder.Show <> -1 Then Exit Sub
   xDir = folder.SelectedItems(1)
   For Each xWs In Application.ActiveWorkbook.Worksheets
      xWs.SaveAs xDir & "\" & xWs.Name, xlCSV
   Next
End Sub

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

//Remove all blank rows

for(var i = usedRng.Rows.Count; i > 0; i--){
    if( xlApp.CountA(usedRng.Rows(i)) == 0 ) usedRng.Rows(i).Delete();
}

//Remove all blank columns

for(var i = usedRng.Columns.Count; i > 0; i--){
    if( xlApp.CountA(usedRng.Columns(i)) == 0 ) usedRng.Columns(i).Delete();
}

Как я могу интегрировать этот код удаления строки / столбца в VBA?

1 Ответ

0 голосов
/ 13 января 2019

Используйте приведенную ниже подпрограмму для удаления пустой строки / столбца в электронной таблице 

Sub RemoveEmptyRowColumn()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    CalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    ActiveSheet.Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    ActiveSheet.DisplayPageBreaks = False
    Firstrow = ActiveSheet.UsedRange.Cells(1).Row
    Lastrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    FirstColumn = ActiveSheet.UsedRange.Cells(1).Column
    LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column

    '------------------
    ' Delete Empty Rows
    '------------------
    For Lrow = Lastrow To Firstrow Step -1
        For LColumn = LastColumn To FirstColumn Step -1
            With ActiveSheet.Cells(Lrow, LColumn)
                If Not IsError(.Value) Then
                    If .Value = "" Then
                        DeleteRow = "Yes"
                    Else
                        DeleteRow = "No"
                        Exit For
                    End If
                End If
            End With
        Next LColumn

        If DeleteRow = "Yes" Then
            ActiveSheet.Cells(Lrow, LColumn + 1).EntireRow.Delete
        End If
    Next Lrow

    '---------------------
    ' Delete Empty Columns
    '---------------------
    For LColumn = LastColumn To FirstColumn Step -1
        For Lrow = Lastrow To Firstrow Step -1
            With ActiveSheet.Cells(Lrow, LColumn)
                If Not IsError(.Value) Then
                    If .Value = "" Then
                        DeleteColumn = "Yes"
                    Else
                        DeleteColumn = "No"
                        Exit For
                    End If
                End If
            End With
        Next Lrow

        If DeleteColumn = "Yes" Then
            ActiveSheet.Cells(Lrow + 1, LColumn).EntireColumn.Delete
        End If
    Next LColumn

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub
...