Question

我在excel中有一个包含大约50列的标签。我将此选项卡导出为.CSV文件并将其上载到数据库中。我目前正在使用此VBA代码导出.CSV文件：

 Sub ExportAsCSV()

 Dim MyFileName As String
 Dim CurrentWB As Workbook, TempWB As Workbook

 Set CurrentWB = ActiveWorkbook
 ActiveWorkbook.ActiveSheet.UsedRange.Copy

 Set TempWB = Application.Workbooks.Add(1)
 With TempWB.Sheets(1).Range("A1")
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteFormats
 End With

 'Dim Change below to "- 4"  to become compatible with .xls files
 MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

 Application.DisplayAlerts = False
 TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
 TempWB.Close SaveChanges:=False
 Application.DisplayAlerts = True

 End Sub

如果未填写其他工作表中的已连接单元格，则此导出选项卡中的某些列将具有“null”（实际单词为null）。如何在此处添加此现有VBA代码以禁止导出是否为null（单词，而不是空白）值？另外如何弹出一个框告诉你它由于空值而无法导出？

Answer 1

我修复了你的代码结构并在开始时添加了一个测试，检查以确保你没有＆＃34; null＆＃34;值ActiveSheet上的任意值 - 如果这样做，它会弹出一个弹出窗口然后退出宏。

Sub ExportAsCSV()

If Application.WorksheetFunction.CountIf(ActiveSheet.UsedRange, "null") > 0 Then
    MsgBox "Null values exist in the range - exiting sub.", vbExclamation
    Exit Sub
End If

Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy

Set TempWB = Application.Workbooks.Add(1)

With TempWB.Sheets(1).Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
End With

'Dim Change below to "- 4"  to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

Application.DisplayAlerts = False

TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False

Application.DisplayAlerts = True

End Sub

Answer 2

它更精细，但我认为这是正确的方法。另外，它激活了第一个＆＃34; null＆＃34;单元格供最终用户查看。

将以下行添加到代码顶部：

Sub ExportAsCSV()
Dim NullAddress As String

    NullAddress = FindNull(ActiveSheet.UsedRange)
    If NullAddress <> vbNullString Then
        ActiveSheet.Range(NullAddress).Activate
        MsgBox "Cannot Export due to ""null"" value in cell"
        Exit Sub
    End If
    '
    '
    '
End Sub

回复测试功能以进行繁重的工作：

Function FindNull(Target As Excel.Range) As String
Const NullValue As String = "null"
Dim vData 'As Variant
Dim Row As Long, Col As Long

    If Not Target Is Nothing Then
        vData = Target
        If IsArray(vData) Then
            For Row = 1 To Target.Rows.Count
                For Col = 1 To Target.Columns.Count
                    If vData(Row, Col) = NullValue Then
                        ' Return the Address of the first Null value found & Exit
                        FindNull = Target.Parent.Cells(Target.Cells(1).Row + Row - 1, Target.Cells(1).Column + Col - 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        Exit Function
                    End If
                Next
            Next
        Else
            If vData = NullValue Then FindNull = Target.Address
        End If
    End If
End Function

如果存在任何空值，如何不允许导出为.CSV

2 个答案: