시트에서 텍스트 파일로 데이터를 복사하는 Excel VBA 복사 쿼리

Question

시트에서 1-300 행의 모든 ​​텍스트를 복사 한 다음 UTF-8 형식의 텍스트 파일에 저장하는 작은 코드가 있습니다. 텍스트가있는 행의 텍스트 만 복사하도록 확장했습니다. 나는 VBA 녀석이 아니야. 이걸 좀 도와 줘.

Sub tgr() 

Dim oStream As Object 
Dim sTextPath As String 
Dim sText As String 
Dim rIndex As Long, cIndex As Long 

sTextPath = Application.GetSaveAsFilename("import.txt", "Text Files, *.txt") 
If sTextPath = "False" Then Exit Sub 

For rIndex = 1 To 300 
    If rIndex > 1 Then sText = sText & vbNewLine 
    For cIndex = 1 To Columns("BC").Column 
    If cIndex > 1 Then sText = sText & vbTab 
    sText = sText & Sheets("IMPORT-SHEET").Cells(rIndex, cIndex).Text 
    Next cIndex 
Next rIndex 

Set oStream = CreateObject("ADODB.Stream") 
With oStream 
    .Type = 2 
    .Charset = "UTF-8" 
    .Open 
    .WriteText sText 
    .SaveToFile sTextPath, 2 
    .Close 
End With 

Set oStream = Nothing 

End Sub 

Answer 1

이 희망에는 텍스트가없는 모든 행을 제외해야한다,이보십시오.

Sub tgr() 

Dim oStream As Object 
Dim sTextPath As String 
Dim sText As String 
Dim sLine As String 
Dim rIndex As Long, cIndex As Long 

sTextPath = Application.GetSaveAsFilename("import.txt", "Text Files, *.txt") 
If sTextPath = "False" Then Exit Sub 

sText = "" 

For rIndex = 1 To 300 
    sLine = "" 
    For cIndex = 1 To Columns("BC").Column 
    If cIndex > 1 Then 
     sLine = sLine & vbTab 
    End If 
    sLine = sLine & Sheets("IMPORT-SHEET").Cells(rIndex, cIndex).Text 
    Next cIndex 
    If Not Len(Trim(Replace(sLine, vbTab, ""))) = 0 Then 
    If rIndex > 1 Then 
     sText = sText & vbNewLine & sLine 
    End If 
    End If 
Next rIndex 

Set oStream = CreateObject("ADODB.Stream") 
With oStream 
    .Type = 2 
    .Charset = "UTF-8" 
    .Open 
    .WriteText sText 
    .SaveToFile sTextPath, 2 
    .Close 
End With 

Set oStream = Nothing 

End Sub