英文:
Export only Rows with Data from CSV
问题
以下是翻译好的部分:
我创建了一个宏以导出CSV文件。我遇到的问题是它会导出所有内容,甚至是空白单元格。
A/B列是必填字段。如果A/B列中没有数据,那么该行将为空。
Sub ExportAsCSV()
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim dtToday As String
    
    dtToday = Format(Date, "MM.DD.YY")
    
    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
    MyFileName = CurrentWB.Path & "\" & "ARMs Upload " & dtToday & ".csv"
    'Optionally, comment previous line and uncomment next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"
    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub
英文:
I created a macro to export a CSV. The issue I am running into is that it is exporting everything, even the blank cells.
Columns A/B are required fields. If there is no data in Columns A/B then that row would be blank.
Sub ExportAsCSV()
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim dtToday As String
    
    dtToday = Format(Date, "MM.DD.YY")
    
    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
    MyFileName = CurrentWB.Path & "\" & "ARMs Upload " & dtToday & ".csv"
    'Optionally, comment previous line and uncomment next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"
    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub
答案1
得分: 2
以下是您要翻译的代码部分:
Sub ExportAsCSV()
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim dtToday As String, rng As Range, i As Long
    
    dtToday = Format(Date, "MM.DD.YY")
    
    Set CurrentWB = ActiveWorkbook
    Set rng = CurrentWB.ActiveSheet.UsedRange '<<<
    rng.copy
    Set TempWB = Application.Workbooks.Add(1)
    
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
    
    'remove any pasted rows without a value in Cols A and B
    For i = rng.Rows.Count To 2 Step -1
        With TempWB.Sheets(1).Rows(i)
            If Application.CountA(.Range("A1:B1")) < 2 Then .Delete
        End With
    Next i
    MyFileName = CurrentWB.Path & "\" & "ARMs Upload " & dtToday & ".csv"
    'Optionally, comment the previous line and uncomment the next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"
    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub
英文:
You can delete any incomplete rowes after the paste:
Sub ExportAsCSV()
    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook
    Dim dtToday As String, rng As Range, i As Long
    
    dtToday = Format(Date, "MM.DD.YY")
    
    Set CurrentWB = ActiveWorkbook
    Set rng = CurrentWB.ActiveSheet.UsedRange '<<<
    rng.copy
    Set TempWB = Application.Workbooks.Add(1)
    
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
    
    'remove any pasted rows without a value in Cols A and B
    For i = rng.Rows.Count To 2 Step -1
        With TempWB.Sheets(1).Rows(i)
            If Application.CountA(.Range("A1:B1")) < 2 Then .Delete
        End With
    Next i
    MyFileName = CurrentWB.Path & "\" & "ARMs Upload " & dtToday & ".csv"
    'Optionally, comment previous line and uncomment next one to save as the current sheet name
    'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"
    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。


评论