如何使用VBA将所有项目从EXCEL工作表中整理到文本文件中？

Question

我在excel工作表中有一个数据块（下面），我想将其放在一个普通的.txt文件中，该文件的结构和逗号分隔为CSV格式样式。这是数据：

dn：uid = 7097202

汽车许可证：113363427

cn：让·阿诺夫斯基

title：LBM356226

st：16777212

• 下一个块用空白行/行分隔*

dn：uid = 8178194

汽车牌照：154052876

cn：Marie Gaulimerg

标题：LBM356227

st：16777219

等等...

我正在使用的代码是这样：

Option Explicit

Sub LDIFParaCSV()
  Dim i, x, intHandle As Integer
  Dim lngNrLinhs As Long
  Dim rgnAlcance As Range
  Dim objFolhaExcel As Worksheet
  Dim strFich, strPChar As String
  Dim arrItemsSep

  Const cntEscrvFich = "csv_ldif.txt"

  intHandle = FreeFile
  Range("A2").Select

  Set objFolhaExcel = ThisWorkbook.Sheets("Sheet1")
  Set rgnAlcance = objFolhaExcel.UsedRange

  lngNrLinhs = rgnAlcance.Rows.Count + rgnAlcance.Row

  strFich = "d:\" & cntEscrvFich
  Open strFich For Output Access Write As #intHandle

  For i = 2 To lngNrLinhs + 1
    If Not IsEmpty(Cells(i, 1)) Then
       arrItemsSep = Split(Cells(i, 1), ":")
       Print #intHandle, arrItemsSep(1)
       ActiveCell.Offset(1, 0).Select
    End If
  Next

  Close #intHandle
End Sub

[我想要实现的是将每个数据块水平放置在txt文件中的一行中（例如：uid = 7097202、113363427，Jean Arnofski，LBM356226、16777212），然后以相同的方式在下一个块中下一段，依此类推，等等...

我在实现这一目标上遇到了很大的困难。抱歉，我想的不是程序员。谢谢

Answer 1

我刚刚在您的代码中添加了几行：

Option Explicit

Sub LDIFParaCSV()
  Dim i, x, intHandle As Integer
  Dim lngNrLinhs As Long
  Dim rgnAlcance As Range
  Dim objFolhaExcel As Worksheet
  Dim strFich, strPChar As String
  Dim arrItemsSep
  Dim printStr As String

    Const csvSeperator = ","
    Const cntEscrvFich = "csv_ldif.txt"

    printStr = ""

    intHandle = FreeFile
    Range("A2").Select

    Set objFolhaExcel = ThisWorkbook.Sheets("Tabelle1")
    Set rgnAlcance = objFolhaExcel.UsedRange

    lngNrLinhs = rgnAlcance.Rows.Count + rgnAlcance.Row

    strFich = "D:\" & cntEscrvFich
    Open strFich For Output Access Write As #intHandle

    For i = 2 To lngNrLinhs + 1
        If Not IsEmpty(Cells(i, 1)) Then
            arrItemsSep = Split(Cells(i, 1), ":")
            'collect string elements
            printStr = printStr & arrItemsSep(1) & csvSeperator
            ActiveCell.Offset(1, 0).Select
        Else
            If printStr <> "" Then                           ' empty lines at end of range?
                printStr = Left(printStr, Len(printStr) - 2) ' remove trailing seperator
                Print #intHandle, Trim(printStr)             ' trim necessary?
                printStr = ""
            End If
        End If
    Next

  Close #intHandle
End Sub