Question

我正在使用我在此处找到的功能：Apend2CSV将更改的行附加到CSV文件。我现在已经在几个不同的项目中成功使用了这个过程，但是这次它忽略了我试图追加的前两列。据我所知，一切都设置正确，我希望有一个更好的眼睛可以指出我的问题在哪里。代码由Worksheet_Change事件触发，但它是一个单独的过程，因为它也由程序的其他部分调用。

在这种情况下，Range（“A4：BB4”）应该被追加，但只有Range（“C4：BB4”）实际上有效。这是一个计算范围，其中的公式可以解释.csv的潜在怪异，例如文本中的引号和逗号，方法是将"的每个实例替换为""，并在值之前将所有值包装在引号中得到附加。

以下是代码：

Sub Append2CSV()
    Sheets("ToCSV").Calculate
    Dim tmpCSV As String
    Dim f As Integer
    Const CSVFile As String = "C:\TheCSV\WBCSV.csv"

    f = FreeFile
    Open CSVFile For Append As #f

    tmpCSV = Range2CSV(Sheets("ToCSV").Range("A4:BB4"))

    Print #f, tmpCSV
    Close #f
    ThisWorkbook.Saved = True
End Sub

Private Function Range2CSV(list) As String
    Dim tmp As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
        cr = 1
        For Each r In list.Cells
            If r.Row = cr Then
                If tmp = vbNullString Then
                    tmp = r.Value
                Else
                    tmp = tmp & "," & r.Value
                End If
            Else
                cr = cr + 1
                If tmp = vbNullString Then
                    tmp = r.Value
                End If
            End If
        Next
    End If
    Range2CSV = tmp
End Function

以下是.csv文件中的文字：

A,AscendSKU,UPCNumber,VendorPartNumber,MFGPartNumber,Divison,G,PhysicalQOHAtTimeOfRecord,AscendQOHAtTimeOfRecord,ChosenVendor,Status,L,M,N,O,P,Q,R,S,Cost,Price,V,W,Location,DateRecordCreated,Z,UniqueID,DateTimeSerial,CurrentAscendQOH,CurrentAscendQOO,CurrentAscendYTD,Brand,ClickHereToStartBuyerModeCategory,AH,DateRecordModified,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,ChangedDuringBuyerMode
"","11833300044D","879410002474","ST6284","ST6284","1","1181 HI-RISE 1-1/8""x31.8 STEM","","0","Hawley","","","","","","","","","","9.01","19.99","","","","42277","","42277.5861111111---...---11833300044D","42277.5861111111","","","","ELEVEN81","Parts - Stems - Mountain and Hybrid","","42277.6491435185","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6517939815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","SPE298655664","719676126357","542-3700","542-3700","1","SPEC FLATBOY GLUELESS PATCHKIT '14""","8","18","Specialized Bicycle Components","","","","","","","","","","1.44","2.99","","","","42063","","42063.7109722222---...---SPE298655664","42063.7109722222","","","","Specialized","Accessories - Flat Repair and Prevention - Patch Kits - Glueless","","42277.6569791666","","","","","","","","","","","","","","","","",""

Answer 1

我会投入我的2c

Sub for testing：

Sub Tester()
    Dim s, fso
    s = getCsvContent(Range("A1").CurrentRegion)
    Set fso = CreateObject("scripting.filesystemobject")
    With fso.createtextfile("C:\users\yournamehere\desktop\temp.csv", True)
        .write s
        .Close
    End With
End Sub

将范围转换为CSV的功能：

Function getCsvContent(rng As Range)
    Dim data, r As Long, c As Long, sep, lb, s, tmp
    data = rng.Value
    s = ""
    lb = ""
    For r = 1 To UBound(data, 1)
        s = s & lb
        sep = ""
        For c = 1 To UBound(data, 2)
            tmp = data(r, c)
            If IsError(tmp) Then tmp = "#Error!" '<<handle errors
            If InStr(tmp, """") > 0 Then
                tmp = Replace(tmp, """", """""")
            End If
            If InStr(tmp, ",") > 0 Then
                tmp = """" & tmp & """"
            End If
            s = s & sep & tmp
            sep = ","
        Next c
        lb = vbNewLine
    Next r
    getCsvContent = s
End Function

Answer 2

这也适用于多行：

Private Function Range2CSV(list) As String
    Dim tmp As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
       cr = list.Row
       For Each r In list.Cells
        If r.Row = cr Then
           tmp = IIf(tmp = vbNullString, r.Value2, tmp & "," & r.Value2)
        Else
           tmp = IIf(r.Rows.Count Mod r.Row, tmp & vbCrLf & r.Value2, tmp & "," & r.Value2)
           cr = r.Row
        End If
      Next
    End If
    Range2CSV = tmp
End Function

用行A4测试它：BB4包含系列1,2,3，...到54

结果：

A,AscendSKU,UPCNumber,VendorPartNumber,MFGPartNumber,Divison,G,PhysicalQOHAtTimeOfRecord,AscendQOHAtTimeOfRecord,ChosenVendor,Status,L,M,N,O,P,Q,R,S,Cost,Price,V,W,Location,DateRecordCreated,Z,UniqueID,DateTimeSerial,CurrentAscendQOH,CurrentAscendQOO,CurrentAscendYTD,Brand,ClickHereToStartBuyerModeCategory,AH,DateRecordModified,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,ChangedDuringBuyerMode
"","11833300044D","879410002474","ST6284","ST6284","1","1181 HI-RISE 1-1/8""x31.8 STEM","","0","Hawley","","","","","","","","","","9.01","19.99","","","","42277","","42277.5861111111---...---11833300044D","42277.5861111111","","","","ELEVEN81","Parts - Stems - Mountain and Hybrid","","42277.6491435185","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6517939815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","SPE298655664","719676126357","542-3700","542-3700","1","SPEC FLATBOY GLUELESS PATCHKIT '14""","8","18","Specialized Bicycle Components","","","","","","","","","","1.44","2.99","","","","42063","","42063.7109722222---...---SPE298655664","42063.7109722222","","","","Specialized","Accessories - Flat Repair and Prevention - Patch Kits - Glueless","","42277.6569791666","","","","","","","","","","","","","","","","",""
A4:BB4
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
A5:BB5
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
A4:BB5
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1

Answer 3

不确定Range2CSV功能是否可以实现，但如果您只想将范围作为CSV字符串，这将起作用：

Private Function Range2CSV(ByVal list As Range) As String
    Dim tmp As String
    Dim r As Range
    Dim rowNum As Long

    rowNum = list.Cells(1, 1).Row
    For Each r In list.Cells
        If r.Row <> rowNum Then
            rowNum = r.Row
            tmp = Left(tmp, Len(tmp) - 1) & vbCrLf  'remove last comma and start new line
        End If
        tmp = tmp & r.Value & ","
    Next
    tmp = Left(tmp, Len(tmp) - 1) & vbCrLf  'remove final comma

    Range2CSV = tmp
End Function

Answer 4

要处理空白第一个单元格的问题，可以在下面的代码中添加指示的行（已测试）。最终，这个答案没有解决其他问题。

Private Function Range2CSV(list) As String
    Dim tmp As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
        cr = 1
        For Each r In list.Cells
            If r.Row = cr Then
                If tmp = vbNullString Then
                     tmp = r.Value
                     If tmp = vbNullString Then tmp = ","  ' <~~~~ add this line
                Else
                    tmp = tmp & "," & r.Value
                End If
            Else
                cr = cr + 1
                tmp = r.Value
            End If
        Next
    End If
    Range2CSV = tmp
End Function

Answer 5

试试这个，但这只输出list中的最后一行数据。

Private Function Range2CSV(list) As String
    Dim sLine As String, sVal As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
        cr = 0 ' Current Row
        For Each r In list.Cells
            ' Check row changes
            If r.Row <> cr Then
                sLine = ""
                cr = r.Row
            End If
            If r.Row = cr Then
                ' Store cell value
                If IsEmpty(r) Then
                    sVal = """""" ' "" in the string output
                Else
                    sVal = r.Value
                End If
                ' Set or Join the values together
                If Len(sLine) = 0 Then
                    sLine = sVal
                Else
                    sLine = sLine & "," & sVal
                End If
            End If
        Next
    End If

    Range2CSV = sLine
End Function

Answer 6

我决定继续尝试考虑在一个范围内实际空白（null）第一个单元格被附加到.csv文件而不用引号括起来等的可能性。以下是我的内容想出了。无论第一个单元格中的值或缺少值，或者附加范围内的任何其他位置，它都可以正常工作。

事实证明，这种方法在处理数千行时实际上效率极低（需要几分钟才能完成。）Tim Williams提供的解决方案要快得多，完成时间不到6秒。

Private Function Range2CSV(list) As String
Dim tmp As String
Dim cr As Long
Dim r As Range
Dim St As Integer

St = 1
tmp = vbNullString
If TypeName(list) = "Range" Then
    cr = list.Row
    For Each r In list.Cells
        If r.Row = cr Then
            tmp = IIf(St = 1, """" & Replace(r.Value, """", """""") & """", tmp & "," & """" & Replace(r.Value, """", """""") & """")
        Else
            tmp = IIf(r.Rows.Count Mod r.Row, tmp & vbCrLf & """" & Replace(r.Value, """", """""") & """", tmp & "," & """" & Replace(r.Value, """", """""") & """")
            cr = r.Row
        End If
        St = 2
    Next
End If
Range2CSV = tmp
End Function

感谢大家的投入。 Paul Bica，你的回答让我最接近，但是这行中的概念存在问题：tmp = IIf（tmp = vbNullString，r.Value2，tmp＆amp;＆＃34;，＆＃34;＆amp; r。值2）通过定义St并检查循环是否正在查看范围中的第一个单元格，我能够考虑具有或没有值的单元格来适当地处理tmp。

将行添加到.csv文件在某种程度上错过了前两列数据

6 个答案: