| 楼主 donghan |
数据透视表自适应的VBA代码在导入外部数据创建数据透视表后,如果文件被移动后或改名后会出现找不到对象的警告，本人将我的数据透视表自适应的VBA代码整理如下： 一、创建数据透视表 1、外部文件为为文本文件： Private Sub Workbook_Open() Dim strCon As String, iPath As String, i As Integer, iFlag As String, iStr As String '定义变量 On Error Resume Next strCon = ActiveSheet.PivotTables(1).PivotCache.Connection '将当前活动数据透视表中缓存连接信息赋值给变量strCon Select Case Left(strCon, 5) 'select case语句,条件为strCon变量中从左侧取5个字符 Case "ODBC;" '用于判断缓存连接信息中的数据连接方式,如果是ODBC方式 iFlag = "DBQ=" '将"DBQ=" 赋值给变量iFlag Case "OLEDB" '用于判断缓存连接信息中的数据连接方式,如果是OLEDB方式 iFlag = "Source=" '将"DBQ=" 赋值给变量iFlag Case Else Exit Sub End Select iStr = Split(Split(strCon, iFlag)(1), ";")(0) '在变量strCon中截取文件路径信息 With ActiveSheet.PivotTables(1).PivotCache '替换数据透视表中缓存信息中的文件完全路径 .Connection = VBA.Replace(strCon, iStr, Path) .CommandText = VBA.Replace(.CommandText, iStr, Path) End With End Sub 2、外部文件为Access数据库 Private Sub Workbook_Open() Dim strCon1 As String, strCon2 As String, iPath As String, i As Integer, iFlag As String, iStr As String '定义变量 On Error Resume Next strCon1 = ActiveSheet.PivotTables(1).PivotCache.Connection '将当前活动数据透视表中缓存连接信息赋值给变量strCon Select Case Left(strCon1, 5) 'select case语句,条件为strCon变量中从左侧取5个字符 Case "ODBC;" '用于判断缓存连接信息中的数据连接方式,如果是ODBC方式 iFlag = "DBQ=" '将"DBQ=" 赋值给变量iFlag Case "OLEDB" '用于判断缓存连接信息中的数据连接方式,如果是OLEDB方式 iFlag = "Source=" '将"DBQ=" 赋值给变量iFlag Case Else Exit Sub End Select iStr = Split(Split(strCon1, iFlag)(1), ";")(0) '在变量strCon中截取文件路径信息 iStr = Left(iStr, InStrRev(iStr, "\") - 1) With ActiveSheet.PivotTables(1).PivotCache '替换数据透视表中缓存信息中的文件完全路径 .Connection = VBA.Replace(strCon1, iStr, Path) .CommandText = VBA.Replace(.CommandText, iStr, Path) End With End Sub 3、外部文件为EXECL文件 Private Sub Workbook_Open() Dim strCon As String, iPath As String, i As Integer, iFlag As String, iStr As String '定义变量 On Error Resume Next strCon = ActiveSheet.PivotTables(1).PivotCache.Connection '将当前活动数据透视表中缓存连接信息赋值给变量strCon Select Case Left(strCon, 5) 'select case语句,条件为strCon变量中从左侧取5个字符 Case "ODBC;" '用于判断缓存连接信息中的数据连接方式,如果是ODBC方式 iFlag = "DBQ=" '将"DBQ=" 赋值给变量iFlag Case "OLEDB" '用于判断缓存连接信息中的数据连接方式,如果是OLEDB方式 iFlag = "Source=" '将"DBQ=" 赋值给变量iFlag Case Else Exit Sub End Select iStr = Split(Split(strCon, iFlag)(1), ";")(0) '在变量strCon中截取文件路径信息 iStr = Left(iStr, InStrRev(iStr, "\") - 1) With ActiveSheet.PivotTables(1).PivotCache '替换数据透视表中缓存信息中的文件完全路径 .Connection = VBA.Replace(strCon, iStr, Path) .CommandText = VBA.Replace(.CommandText, iStr, Path) End With End Sub 二、创建查询表 Private Sub Workbook_Open() Dim strCon As String, iPath As String, i As Integer, iFlag As String, iStr As String strCon = ActiveSheet.QueryTables(1).Connection Select Case Left(strCon, 5) Case "ODBC;" iFlag = "DBQ=" Case "OLEDB" iFlag = "Source=" Case Else Exit Sub End Select iStr = Split(Split(strCon, iFlag)(1), ";")(0) '在变量strCon中截取文件路径信息 iStr = Left(iStr, InStrRev(iStr, "\") - 1) With ActiveSheet.QueryTables(1) .Connection = VBA.Replace(strCon, iStr, Path) .CommandText = VBA.Replace(.CommandText, iStr, Path) End With End Sub 由上可看出，自动路径的代码大致一样，只有红色部分有变化，大家可以根据需要，自己测试其它类型的外部数据源，代码一样的可以合并。 总结：1、如果创建的是数据透视表用PivotTables(1).PivotCache， 如果创建的是查询表用QueryTables(1).。 2、如果外部数据源不可再分（如TXT文件），用 iStr = Split(Split(strCon, iFlag)(1), ";")(0) ， 如果外部数据源可再分（如EXECL文件，可分为SHEET1、SHEET2。，ASSECC文件可再分为表、视图等），此时用 iStr = Split(Split(strCon, iFlag)(1), ";")(0) iStr = Left(iStr, InStrRev(iStr, "\") - 1) |
| 2楼 wnianzhong |
先收藏起来慢慢学,即深透视表,又VBA. |
| 3楼 松儿 |
收藏学习，谢谢! |
| 4楼 APOLLO |
谢谢************！ |
| 5楼 MOUSEJAME |
学习，要慢慢了解 |
| 6楼 yuki0601 |
我也先收藏着，今天脑子真的不够用了！太累了！ |