将每一行创建为文件,将每列创建为内容?

时间:2015-04-17 16:55:39

标签: excel vba excel-vba

[1]: 如何创建每个行的文件以及包含标题和每列值的每个文件。感谢。

示例:

      Name Age   Sex
Fi1e1  Maria 24    F
File2  Agnes 23    F
File3   John  23   M

结果: 所有文件都包含每列的名称和值:

File1
Name Age Sex
Maria 24  F  

File2
Name Age Sex
Agnes  23  F

感谢。


这是我到目前为止得到的内容,但我无法将其他列放在文件中。

Sub Export_Files()
Dim fiLEs, sFN
Dim rArticleName As Range
Dim rContent As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object

'fiLEsr = path to the folder you want to export to
'oSh = The sheet where your data is stored
fiLEs = "C:\Documents\Users\"
Set oSh = Sheet1

Set oFS = CreateObject("Scripting.Filesystemobject")

For Each rArticleName In oSh.UsedRange.Columns("A").Cells
    Set rContent = rArticleName.Offset(, 1)


    sFN = rArticleName.Value & ".csv"
    Set oTxt = oFS.OpenTextFile(fiLEs & "\" & sFN, 2, True)
    oTxt.Write rContent.Value
    oTxt.Close
Next
End Sub

1 个答案:

答案 0 :(得分:0)

Sub Export_Files()
Dim fiLEs, sFN
Dim rArticleName As Range
Dim rContent As Range, rHdr As Range
Dim sHdr  As String, sContent As String
Dim oSh As Worksheet
Dim a As Object, v
Set a = Application

    fiLEs = "D:\temp\" '"C:\Documents\Users\"
    Set oSh = Sheet1

    Set rHdr = oSh.Range(oSh.Range("B1"), _
               oSh.Cells(1, Columns.Count).End(xlToLeft))

    sHdr = Join(a.Transpose(a.Transpose(rHdr.Value)), ",")

    For Each rArticleName In oSh.UsedRange.Columns("A").Cells
        v = rArticleName.Value
        If Len(v) > 0 Then
            Set rContent = rArticleName.Offset(0, 1).Resize(1, _
                                             rHdr.Columns.Count)
            sContent = Join(a.Transpose(a.Transpose(rContent.Value)), ",")
            sFN = v & ".csv"
            CreateTextFile fiLEs & sFN, sHdr & vbCrLf & sContent
        End If
    Next
End Sub

Sub CreateTextFile(sPath As String, sContent As String)
    Static fso As Object
    If fso Is Nothing Then Set fso = CreateObject("scripting.filesystemobject")
    With fso.CreateTextFile(sPath)
        .write sContent
        .Close
    End With
End Sub