Question

我正在使用以下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

要删除空白行和列，我能够在.hta应用程序中使用下面的JavaScript，但希望将相同的功能集成到上面的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中？

Answer 1

使用下面的子例程删除电子表格中的空行/列

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

在csv中将VBA中的空白列/行删除

1 个答案: