Export only Rows with Data from CSV 只导出带有数据的行到CSV

huangapple go评论58阅读模式
英文:

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, &quot;MM.DD.YY&quot;)
    
    Set CurrentWB = ActiveWorkbook
    Set rng = CurrentWB.ActiveSheet.UsedRange &#39;&lt;&lt;&lt;
    rng.copy

    Set TempWB = Application.Workbooks.Add(1)
    
    With TempWB.Sheets(1).Range(&quot;A1&quot;)
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With
    
    &#39;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(&quot;A1:B1&quot;)) &lt; 2 Then .Delete
        End With
    Next i

    MyFileName = CurrentWB.Path &amp; &quot;\&quot; &amp; &quot;ARMs Upload &quot; &amp; dtToday &amp; &quot;.csv&quot;
    &#39;Optionally, comment previous line and uncomment next one to save as the current sheet name
    &#39;MyFileName = CurrentWB.Path &amp; &quot;\&quot; &amp; CurrentWB.ActiveSheet.Name &amp; &quot;.csv&quot;


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

End Sub

huangapple
  • 本文由 发表于 2023年4月20日 00:47:11
  • 转载请务必保留本文链接:https://go.coder-hub.com/76057000.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定