0

这个脚本做了我需要的所有事情，但只有一件事：它只导出 Col B，我需要它导出 col B:H（使用 A 作为文件名，这个脚本就是这样做的）。

编辑：实际上，我现在不确定是否可以使用这种方法。我更仔细地查看了生成的 md 文件，到处都有额外的 " 标记，例如，在文件的开头和结尾，以及 excel 单元格内容中的所有合法引号。结束编辑。

Sub DataDump()

Dim X
Dim lngRow As Long
Dim StrFolder As String

StrFolder = "C:\temp"
X = Range([a1], Cells(Rows.Count, 2).End(xlUp))
For lngRow = 1 To UBound(X)
Open StrFolder & "\" & X(lngRow, 1) & ".md" For Output As #1
Write #1, X(lngRow, 2)
Close #1
Next
End Sub

目的：

我需要将每一行导出为一个 md 文件，其中 Col A 成为标题，内容是 Cols B:H。我可以在谷歌表格中做到这一点，但由于源代码在 excel 中，我更喜欢使用 VBA。这是我发现的第一个成功（并且超快）的脚本（我有 7,000 行）。

我试过的：

我试过修改范围，我把所有的“2”都增加到了“5”，认为这是一个列，但事实并非如此；选择 5 仅意味着它使用该单列。

我很少使用 excel，所以我真的不知道如何使用 VBA，但是我确实有这个 google sheet 脚本可以解决问题（在我一次将 100 行从 excel 复制/粘贴到 gsheets 之后），但是伙计是慢，我一次只能做 100 行。如果有帮助，这是谷歌表格脚本：

  function saveRowsToMDfile() {
  var ss = SpreadsheetApp.getActive();
  var sheet = ss.getActiveSheet();
  var range = sheet.getRange("A1:H100");
    var rows = range.getValues();
  var folder = DriveApp.getFoldersByName("Test").next();
  var files = folder.getFiles();
  while(files.hasNext()) files.next().setTrashed(true);
  rows.forEach(function(row) {
    var title = row[0]; //set first element of array as title
    row.shift(); //remove first element of the array 
    var content = row.join("\n");
    folder.createFile(title + ".md", content);
  }); 
}

对于可能会问同样问题的其他人，以下脚本将行 AH 保存为 md 文件，其中 col A 是文件名（您可以修改列数并将 md 更改为 txt 并修改文件保存的路径）作为没有 BOM 的 UTF8。我对 VB 不够熟悉，不知道可以从这个脚本中删除什么——我所知道的是它就像魅力一样工作：

Sub DataDump()
    
    Const STR_FOLDER As String = "D:\FilmDatabase\"
    Dim ws As Worksheet, lngRow As Long, arr
    
    Set ws = ActiveSheet
    For lngRow = 1 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        'get row as 2D array and convert to 1D array
        arr = Application.Transpose(Application.Transpose(ws.Cells(lngRow, "B").Resize(1, 7).Value))
        PutContent3 STR_FOLDER & ws.Cells(lngRow, 1) & ".md", Join(arr, vbLf)
    Next lngRow
    
End Sub



'EDIT: try this  - may handle accented text better
'https://stackoverflow.com/questions/2524703/save-text-file-utf-8-encoded-with-vba
Sub PutContent2(f As String, content As String)
    With CreateObject("ADODB.Stream")
        .Type = 2 'text/string data
        .Charset = "utf-8"
        .Open
        .WriteText content
        .SaveToFile f, 2 'Save to disk
    End With
End Sub

Sub PutContent3(f As String, content As String)
    
    Dim BinaryStream As Object
    Dim UTFStream As Object

    Set UTFStream = CreateObject("adodb.stream")

    UTFStream.Type = 2
    UTFStream.Mode = 3
    UTFStream.Charset = "UTF-8"
    UTFStream.Open
    UTFStream.WriteText content

    UTFStream.Position = 3 'skip BOM

    Set BinaryStream = CreateObject("adodb.stream")
    BinaryStream.Type = 1
    BinaryStream.Mode = 3
    BinaryStream.Open

    UTFStream.CopyTo BinaryStream

    UTFStream.Flush
    UTFStream.Close
    Set UTFStream = Nothing

    BinaryStream.SaveToFile f, 2
    BinaryStream.Flush
    BinaryStream.Close
    Set BinaryStream = Nothing
End Sub
4

1 回答 1

1

尝试这个：

Sub DataDump()
    
    Const STR_FOLDER As String = "C:\tester\tmp\"
    Dim ws As Worksheet, lngRow As Long, arr
    
    Set ws = ActiveSheet
    For lngRow = 1 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        'get row as 2D array and convert to 1D array 
        arr = Application.Transpose(Application.Transpose(ws.Cells(lngRow, "B").Resize(1, 7).Value))
        PutContent STR_FOLDER & ws.Cells(lngRow, 1) & ".md", Join(arr, vbLf)
    Next lngRow
    
End Sub

'write out a text file...
Sub PutContent(f As String, content As String)
    CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 2, True).Write content
End Sub

'EDIT: try this  - may handle accented text better
'https://stackoverflow.com/questions/2524703/save-text-file-utf-8-encoded-with-vba
Sub PutContent2(f As String, content As String)
    With CreateObject("ADODB.Stream")
        .Type = 2 'text/string data
        .Charset = "utf-8" 
        .Open
        .WriteText content
        .SaveToFile f, 2 'Save to disk
    End With
End Sub
于 2021-07-16T00:13:20.640 回答