国产一区二区欧美精品免费-欧美国产日韩在线视频-欧美亚洲国语精品一区二区-欧美激情五月综合啪啪-国产69精品麻豆久久久久-亚洲人成精品久久久久桥网站-欧美刺激肥熟在线视频-十七岁日本免费完整版BD-黑夜在线拖拽不卡第一页

SQL+數(shù)據(jù)透視表+VBA 使數(shù)據(jù)透視表走向更靈活，更智能，更適用。
這個(gè)是我和師傅一撇首度合作，他提供了文件并提出了要求，我?guī)退麑?shí)現(xiàn)其效果
下面從幾個(gè)方面解釋一下：

1、功能
一個(gè)源文件和一個(gè)通過用SQL查詢生成的數(shù)據(jù)透視表
將源文件拖到電腦的任意位置，甚至將文件名也改掉，用VBA配上代碼和窗體找到文件，數(shù)據(jù)透視表仍然能夠正常工作
2、套用
現(xiàn)在來講講怎么使做出來的東東適應(yīng)大家的需要
2、1
用OLE DB窗口引用工作表或?qū)慡QL語句，因?yàn)橛眠@個(gè)方法同VBA相通，copy下來代碼區(qū)的的語句
2、2
打開透視表文件，將透視表中的字段全部拖出來，也就是變成一個(gè)空數(shù)據(jù)透視表。
右擊下面工作表圖標(biāo) 或者 工具》宏》visual basic 編輯器，點(diǎn)擊模塊看到代碼區(qū)
2、3
將2、1步驟copy的語句commandtext的數(shù)據(jù)Array中的引號(hào)中
.CommandText = Array("    ")
可能不同版本會(huì)有一些差別，同時(shí)SQL語句中如果添加了文本生成新字段，雙引號(hào)要成對(duì)翻倍
如："出庫" AS 表單選項(xiàng) 要改成 ""出庫"" AS 表單選項(xiàng)
2、4
語句太長(zhǎng)的處理：在代碼區(qū)如果你想好看一些，你可以插入“ _”來換行，當(dāng)然不能插在一個(gè)單詞或自動(dòng)名等中間。
2、5
將文件存盤，重新打開就會(huì)有了數(shù)據(jù)，你可以將字段拖入數(shù)據(jù)透視表中，創(chuàng)建你自己的數(shù)據(jù)透視表，
2、6
這樣文件就可以使用，相信VBA的引導(dǎo)不用教就可以交給別人使用了

下面附上代碼，包含3個(gè)區(qū)：

1、 工作簿去，打開文件時(shí)工作
Private Sub Workbook_Open()
Dim OP

If Dir(Sheets("path").Range("A1")) = "" Then
    OP = MsgBox("源文件已被移走，請(qǐng)選擇下列選項(xiàng)" + Chr(10) + "1、選擇是，重新輸入文件全名" + Chr(10) + "2、選擇否，打開原有的數(shù)據(jù)透視表" + Chr(10) + "3、選擇取消，關(guān)閉文件", vbYesNoCancel, "Scarlett溫馨提示")
    If OP = vbYes Then
        UserForm1.Show
    End If
    If OP = vbNo Then
        ActiveWorkbook.Close True
    End If
   
    If OP = vbCancel Then
        Exit Sub
    End If
   
Else
    Call refreshpv
End If
End Sub

2、窗體區(qū)，實(shí)現(xiàn)文件的查找
Private Sub CommandButton1_Click()
Dim fopen As FileDialog
Set fopen = Application.FileDialog(msoFileDialogFilePicker)
fopen.Show
TextBox1.Value = fopen.SelectedItems(1)
Set fopen = Nothing
End Sub

Private Sub CommandButton2_Click()
If InStr(TextBox1.Value, ".") > 0 Then
    Sheets("path").Range("A1") = TextBox1.Value
    Call refreshpv
    unload me
Else
    MsgBox "文件名要帶路徑含后綴的文件名", "Scarlett_88溫馨提示"
    TextBox1.SetFocus
End If
End Sub

Private Sub CommandButton3_Click()
Unload Me
End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Activate()

End Sub

Private Sub UserForm_Click()
TextBox1.Value = Sheets("path").Range("A1")
End Sub