Excel 在现有ADO记录集中追加字段

我使用Excel中的ADO记录集获取一个巨大的CSV（约100万行），并将其用作外部数据来创建数据透视缓存和数据透视表

我想编辑记录集以附加其他字段（列），并添加从其中一个字段（即具有如下字符串数据的week字段）计算的数据：

e、 g.如果A、B、C是记录集字段

    A         B        C        D        E
w 2011 01                       01    2011
w 2011 02                       02    2011
w 2011 03                       03    2011
w 2011 04                       04    2011
w 2012 05                       05    2012

然后我想附加字段D，E，并向它们添加数据，如上图所示，从A列中剥离，就像我在excel中所做的那样

D=值（右（A2,2）） E=值（中间值（A2,3,4））

但是我想用SQL函数来做

然后，我使用此附加记录集创建数据透视缓存和数据透视表，并将其用作外部数据源。请参阅代码中的注释。我无法将该记录集克隆到新记录集中，因为它会给我一些书签不可用错误

以下是我的错误：

Option Explicit 

Sub GetCSV() 
Application.EnableEvents = False 
Application.DisplayAlerts = False 
Application.ScreenUpdating = False 

Dim sFileName As String 
Dim sFilePath As String 
Dim rngPivotDest As Range 
Dim pcPivotCache As PivotCache 
Dim ptPivotTable As PivotTable 
Dim SQL As String 
Dim sConnStrP1 As String 
Dim sConnStrP2 As String 
Dim cConnection As Object 
Dim rsRecordset As Object, RS As Object, Fld As Object 
Dim Sht As Worksheet 
Dim Conn As Object 

With ThisWorkbook 

Set rsRecordset = CreateObject("ADODB.Recordset") 
Set RS = CreateObject("ADODB.Recordset") 
Set cConnection = CreateObject("ADODB.Connection") 


sFileName = Application.GetOpenFilename("Text Files, *.asc; *.txt; *.csv", 1, "Select a      Text File", , False) 
sFilePath = Left(sFileName, InStrRev(sFileName, "\")) 
sFileName = Replace(sFileName, sFilePath, "") 

sConnStrP1 = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" 
sConnStrP2 = ";Extensions=asc,csv,tab,txt;FIL=text;Persist Security Info=False" 

cConnection.Open sConnStrP1 & sFilePath & sConnStrP2 
SQL = "SELECT * FROM [" & sFileName & "]" 
Set rsRecordset = cConnection.Execute(SQL) 


'****** THIS ENTIRE PART IS NOT WORKING****** 
With RS 
.cursorlocation = 3 'aduseclient 
.cursortype = 2 'adOpenDynamic 3 'adopenstatic 
'    For Each Fld In rsRecordset.Fields 
'        .Fields.append Fld.Name, Fld.Type, Fld.definedsize, Fld.Attributes,     Fld.adFldIsNullable 
'    Next Fld 
.locktype = 4 'adLockBatchOptimistic'3 'adlockoptimistic 
.Fields.append "WeekNumber", 3 'adinteger 
.Fields.append "Year", 7 'addate 

.Open 
.Update 

'do something to grab the entire data into RS 
Set RS = rsRecordset.Clone 

'or something like 
Set RS = rsRecordset.getrows 

'append some function code to the last 2 fields to strip YEAR & WEEK from 1st field. 
...... 
...... 


End With 
********************************* 

'Delete any connections in workbook 
On Error Resume Next 
For Each Conn In .Connections 
    Conn.Delete 
Next Conn 
On Error GoTo 0 

'Delete the Pivot Sheet 
On Error Resume Next 
For Each Sht In .Sheets 
If LCase(Trim(Sht.Name)) = LCase("Pivot") Then Sht.Delete 
Next Sht 
On Error GoTo 0 

'Create a PivotCache 
Set pcPivotCache = .PivotCaches.Create(SourceType:=xlExternal) 
Set pcPivotCache.Recordset = rsRecordset 

'Create a Pivot Sheet 
.Sheets.Add after:=.Sheets("Main") 
ActiveSheet.Name = "Pivot" 

'Create a PivotTable 
Set ptPivotTable =  pcPivotCache.CreatePivotTable(TableDestination:=.Sheets("Pivot").Range("A3")) 

With ptPivotTable 
    .Name = "PivotTable" 
    .SaveData = False 
End With 


With ptPivotTable 
    With .PivotFields("Level") 
       .Orientation = xlPageField 
       .Position = 1 
    End With 
With .PivotFields("Cat") 
    .Orientation = xlPageField 
    .Position = 1 
End With 
With .PivotFields("Mfgr") 
    .Orientation = xlPageField 
    .Position = 1 
End With 
With .PivotFields("Brand") 
    .Orientation = xlPageField 
    .Position = 1 
End With 
With .PivotFields("Descr") 
    .Orientation = xlRowField 
    .Position = 1 
End With 
End With 

ptPivotTable.AddDataField ptPivotTable.PivotFields("Sales Value from CrossCountrySales"), "Sum of Sales Value from CrossCountrySales", xlSum 

With ptPivotTable.PivotFields("Week") 
    .Orientation = xlColumnField 
    .Position = 1 
End With 

With ptPivotTable.PivotFields("Sum of Sales Value from CrossCountrySales") 
    .Calculation = xlNoAdditionalCalculation 
End With 

cConnection.Close 
Set rsRecordset = Nothing 
Set cConnection = Nothing 
Set Conn = Nothing 

End With 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableEvents = True 

End Sub

---

您可以在原始SQL查询中创建这些新字段

下面是一个简化的示例：我正在查询一个txt文件“week.txt”（它只有一列标题为“week”和几行测试数据），并将记录集放到工作表上

Sub GetCSV()

    Dim SQL As String
    Dim sConnStrP1 As String
    Dim cConnection As Object
    Dim rsRecordset As Object, RS As Object
    Dim Conn As Object, i As Integer

    Set rsRecordset = CreateObject("ADODB.Recordset")
    Set RS = CreateObject("ADODB.Recordset")
    Set cConnection = CreateObject("ADODB.Connection")

    sConnStrP1 = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
                 "Dbq=C:\_Stuff\test\" & _
                 ";Extensions=asc,csv,tab,txt;FIL=text;Persist Security Info=False"

    cConnection.Open sConnStrP1

    'create new columns based on "week" column
    '  1*(....) coerces to number
    SQL = "SELECT [week], 1*(right(week,2)) as wk_num, 1*(mid(week,3,4)) as year FROM [week.txt]"

    Set rsRecordset = cConnection.Execute(SQL)

    'drop to sheet...
    With ActiveSheet.Range("D5")
        For i = 0 To rsRecordset.Fields.Count - 1
            .Offset(0, i).Value = rsRecordset.Fields(i).Name
        Next i
        .Offset(1, 0).CopyFromRecordset rsRecordset
    End With


End Sub

---

您是否尝试过在SQL查询中创建和填充这些附加列，而不是在之后添加它们？嗨，Tim，我不知道如何通过SQL添加这些列及其提取的数据。我的SQL查询是从CSV中选择整个数据，稍后将用于创建透视表。我没有看到您选择csv数据，但是您只定义了一个select查询来查询week列并创建year和weeknumber列。我不会将任何数据放到工作表中，而是创建一个外部数据透视缓存并使用它创建一个数据透视表。我没有在源csv中添加列的原因是因为它大约有100万行，我不知道怎么做。我想在记录集中添加weeknumber和year列，以便它们能够显示并在数据透视表中使用。谢谢Tim，编辑SQL查询很有效。SQL=“选择*，[week]，1*（右（week，2））作为周数，1*（周中，3,4））作为年，从[”&sFileName&“]”[week.txt]“很高兴你成功了-我的示例只是为了说明一般方法：我知道你对数据集做了一些不同的事情。是的，我发布了3年（即156周）的产品销售数据，我想在52周内合理安排，因为我的想法是，一个新产品一旦推出，将只运行不超过52周。在某些周之间可能会有空白（空白，即没有销售），但3年内销售周的总计数不会超过52周。逻辑是，从第一周开始的任何产品销售，即w 2011 01，但在这种情况下，总销售周计数，整个销售周从周列开始：52个销售周计数+1。关于如何在SQL查询中作为另一个名为say'newweek'的专栏实现这一点，您有什么想法吗？