Fatal编程技术网
  • vba/
  • Vba 将行追加到.csv文件会丢失前两列数据

Vba 将行追加到.csv文件会丢失前两列数据

vba excel csv

Vba 将行追加到.csv文件会丢失前两列数据,vba,excel,csv,Vba,Excel,Csv,我正在使用我在这里找到的一个函数：将更改的行附加到CSV文件。我现在已经在几个不同的项目中成功地使用了这个过程，但是这次它省略了我试图附加的前两列。据我所知，一切都安排妥当了，我希望有人对此有更好的眼光，能指出我的问题所在。代码由工作表更改事件触发，但它是一个单独的过程，因为程序的其他部分也会调用它 在本例中，范围（“A4:BB4”）应该被追加，但实际上只有范围（“C4:BB4”）被追加。这是一个计算范围，其中的公式解释了.csv的潜在奇怪之处，例如文本中的引号和逗号，方法是将“的每个实例替换为

我正在使用我在这里找到的一个函数：将更改的行附加到CSV文件。我现在已经在几个不同的项目中成功地使用了这个过程，但是这次它省略了我试图附加的前两列。据我所知，一切都安排妥当了，我希望有人对此有更好的眼光，能指出我的问题所在。代码由工作表更改事件触发，但它是一个单独的过程，因为程序的其他部分也会调用它

在本例中，范围（“A4:BB4”）应该被追加，但实际上只有范围（“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
以下是.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","","","","","","","","","","","","","","","","",""
这也适用于多行：

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
使用包含系列1,2,3…至54的A4:BB4行对其进行测试

结果:

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
不确定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

私有函数Range2CSV（ByVal列表作为范围）作为字符串
将tmp设置为字符串
调光范围
Dim rowNum尽可能长
rowNum=list.Cells（1，1）.Row
对于列表单元格中的每个r
如果r.行rowNum，则
rowNum=r.行
tmp=Left（tmp，Len（tmp）-1）&vbCrLf'删除最后一个逗号并开始新行
如果结束
tmp=tmp&r.值&“
下一个
tmp=Left（tmp，Len（tmp）-1）和vbCrLf'删除最后的逗号
范围2CSV=tmp
端函数
要解决第一个单元格为空的问题，您可以将下面的指示行添加到代码（已测试）中。最终，此答案不会解决其他问题（如果有）

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

私有函数Range2CSV（列表）作为字符串
将tmp设置为字符串
如长
调光范围
如果TypeName（list）=“范围”，则
cr=1
对于列表单元格中的每个r
如果r.行=cr，则
如果tmp=vbNullString，则
tmp=r.值

如果tmp=vbNullString，则tmp=“，”尝试此操作，但这仅输出
列表中的最后一行数据


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



私有函数Range2CSV（列表）作为字符串
Dim sLine作为字符串，sVal作为字符串
如长
调光范围
如果TypeName（list）=“范围”，则
cr=0'当前行
对于列表单元格中的每个r
'检查行更改
如果r.行cr，则
sLine=“”
cr=r.行
如果结束
如果r.行=cr，则
'存储单元值
如果是空的（r），那么
字符串输出中的sVal=“”“”
其他的
sVal=r.值
如果结束
'将值设置或连接在一起
如果Len（sLine）=0，则
sLine=sVal
其他的
sLine=sLine&“，”和sVal
如果结束
如果结束
下一个
如果结束
范围2CSV=sLine
端函数

我要加入我的2c

用于测试的子组件：


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



函数getCsvContent（rng As范围）
变光数据，r为长，c为长，sep，lb，s，tmp
数据=平均值
s=“”
lb=“”
对于r=1到uBond（数据，1）
s=s&lb
sep=“”
对于c=1至UBound（数据，2）
tmp=数据（r，c）
如果IsError（tmp），则tmp=“#错误！”“那么是0
tmp=“”&tmp&“
如果结束
s=s&sep&tmp
sep=“，”
下一个c
lb=vbNewLine
下一个r
getCsvContent=s
端函数

我决定继续并尝试解释实际为空（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&“，”&r.Value2）

通过定义St并检查循环是否查看范围中的第一个单元格，我可以说明该单元格是否具有适当处理tmp的值。
请您也添加一个CSV文件的示例好吗？几行可能会有帮助。抱歉，我没有看到这样做的方法。我如何添加文件？您可以编辑您的帖子（单击编辑）然后粘贴文件的前3-5行——或者粘贴数据的模型，如果它是敏感的。这样我们就可以看到它的格式。哦，太难看了……它有很多列。要导出的数据的前两列有任何内容吗？没有任何更改。它仍然保留前两列。我在复制了发布并测试它，请确认它仍然保留了2列。我现在想出了一个解决方案，但我肯定想知道这到底是怎么回事……我的解决方案是将数据移动到附加2列以上，并将原始范围（包括2列）附加到右侧。这样可以得到我需要附加的数据，但他简直让我难以置信！谢谢你的帮助。我现在得走了，但明天我会回来看这些东西。我做了另一个更新，但是

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