Question

大家好日子，

我有这个宏，它使用公式导出所有单元格，但是输出空白。

我只想将显示为非空白的单元格导出。有什么想法吗？

Sub Export_A()

Dim sPath As String
Dim SFile As String
Dim nLog As Integer

sPath = "C:\AAAWork\"
SFile = sPath & ActiveSheet.Range("P9") & ".txt"

nfile = FreeFile

Open SFile For Output As #nfile

For i = 1 To ActiveSheet.UsedRange.Rows.Count

Set ThisCell = ActiveSheet.Range("A" & i)

If ThisCell.Text <> "" Then
 '   sInDate = ThisCell.Text

    'sOutDate = Format(ThisCell.Value, "mm/yyyy")
    sOutDate = Format(ThisCell.Value, "yyyy-mm")
    'stemp = """" & sOutDate & """" this gives the date the " in the    
beginning and end
    stemp = "" & sOutDate & ""


    For j = 1 To 10
        If j = 1 Or j = 2 Or j = 9 Then
            stemp = stemp & ";" & ThisCell.Offset(0, j)
        Else
            'stemp = stemp & "," & """" & ThisCell.Offset(0, j) & """" This 
gives every value a " beginning and end
            stemp = stemp & ";" & ThisCell.Offset(0, j)
        End If
    Next
End If
Print #nfile, stemp
Next
Close #nfile


MsgBox ("Completed a file called " & SFile & " has been generated")

End Sub

这是一种有趣的导出为CSV的方式，但它是继承的，并且做得非常好。

Answer 1

尝试将写入行放在For循环的末尾

Sub Export_A()

Dim sPath As String
Dim SFile As String
Dim nLog As Integer

sPath = "C:\AAAWork\"
SFile = sPath & ActiveSheet.Range("P9") & ".txt"

nfile = FreeFile

Open SFile For Output As #nfile

For i = 1 To ActiveSheet.UsedRange.Rows.Count

Set ThisCell = ActiveSheet.Range("A" & i)

If ThisCell.Text <> "" Then
 '   sInDate = ThisCell.Text

    'sOutDate = Format(ThisCell.Value, "mm/yyyy")
    sOutDate = Format(ThisCell.Value, "yyyy-mm")
    'stemp = """" & sOutDate & """" this gives the date the " in the beginning and end
    stemp = "" & sOutDate & ""


    For j = 1 To 10
        stemp = stemp & ";" & ThisCell.Offset(0, j)
    Next

    Print #nfile, stemp

End If

Next
Close #nfile


MsgBox ("Completed a file called " & SFile & " has been generated")

End Sub

Answer 2

first you don't need this if statement as the output is the same if it's true or false

    If j = 1 Or j = 2 Or j = 9 Then
        stemp = stemp & ";" & ThisCell.Offset(0, j)
    Else
        'stemp = stemp & "," & """" & ThisCell.Offset(0, j) & """" This gives every value a " beginning and end
        stemp = stemp & ";" & ThisCell.Offset(0, j)
    End If

If the blanks are in the following columns you could change to code to:

    If ThisCell.Offset(0, j) <> "" Then
        stemp = stemp & ";" & ThisCell.Offset(0, j)
    End If

Which will skip blank columns

Excel VBA：宏仅导出非空白单元格

2 个答案: