免费视频淫片aa毛片_日韩高清在线亚洲专区vr_日韩大片免费观看视频播放_亚洲欧美国产精品完整版

在編寫vba代碼的解決方案時，經(jīng)常需要在不同的工作簿之間讀寫數(shù)據(jù)。

接下來介紹幾種在不同的excel工作簿之間讀寫數(shù)據(jù)的方法：

一、打開讀寫法

1、單個文件固定路徑打開讀寫法：

代碼如下：

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    Dim oWB As Workbook
    Dim oWK As Worksheet
    Dim sFilePath As String
    Dim iRow As Long
    '固定路徑
    sFilePath = "E:\test.xlsx"
    Set oWB = Excel.Workbooks.Open(sFilePath)
    With oWB
        Set oWK = .Worksheets(1)
        With oWK
            iRow = .Range("a65536").End(xlUp).Row
            '***********************************
            '其它操作代碼
            '***********************************
        End With
        Excel.Application.Calculation = xlCalculationAutomatic
        Excel.Application.DisplayAlerts = True
        Excel.Application.ScreenUpdating = True
        .Close
    End With
    MsgBox "操作完成!"
    Set oWK = Nothing
    Set oWB = Nothing
End Sub

2、任意選擇單個或多個文件打開讀寫法：

代碼如下:

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    '選擇路徑讀取打開法
    Dim oWB As Workbook
    Dim oWK As Worksheet
    Dim oFD As FileDialog
    Dim sFilePath As String
    Dim iRow As Long
    '創(chuàng)建一個選擇文件對話框
    Set oFD = Excel.Application.FileDialog(msoFileDialogFilePicker)
    '聲明一個變量用來存儲選擇的文件名
    Dim vrtSelectedItem As Variant
    With oFD
        '允許選擇多個文件
        .AllowMultiSelect = True
        '使用Show方法顯示對話框，如果單擊了確定按鈕則返回-1。
        If .Show = -1 Then
            '遍歷所有選擇的文件
            For Each vrtSelectedItem In .SelectedItems
                '獲取所有選擇的文件的完整路徑,用于各種操作
                sFilePath = vrtSelectedItem
                Set oWB = Excel.Workbooks.Open(sFilePath)
                With oWB
                    Set oWK = .Worksheets(1)
                    With oWK
                        iRow = .Range("a65536").End(xlUp).Row
                        '***********************************
                        '其它操作代碼
                        '***********************************
                    End With
                    Excel.Application.Calculation = xlCalculationAutomatic
                    .Close
                End With
            Next
        Set oWK = Nothing
        Set oWB = Nothing
        End If
    End With
    Excel.Application.DisplayAlerts = True
    Excel.Application.ScreenUpdating = True
End Sub

3、任意選擇文件夾及其子文件夾打開讀寫法：

除了固定路徑的單個文件和選擇任意多個文件打開讀寫以外，我們往往還需要通過選擇具體的文件夾，然后遍歷文件夾內(nèi)的所有文件進(jìn)行打開讀寫，代碼如下：

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    Dim sPath As String
    '選擇要操作的文件夾
    sPath = GetPath()
    If Len(sPath) Then
        '開始遍歷選中的文件夾中的所有文件
        EnuAllFiles sPath, False
        MsgBox "操作完成!!!"
    End If
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
    Excel.Application.ScreenUpdating = True
End Sub
Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False)
    '定義文件系統(tǒng)對象
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    '定義文件夾對象
    Dim oFolder As Object
    Set oFolder = oFso.GetFolder(sPath)
    '定義文件對象
    Dim oFile As Object
    Dim oWB  As Workbook
    Dim oWK As Worksheet
    Dim oWB1  As Workbook
    Dim oWK1 As Worksheet
    Set oWB = Excel.ThisWorkbook
    Set oWK = oWB.Worksheets(1)
    iRow = oWK.Range("A65536").End(xlUp).Row
    '如果指定的文件夾含有文件
    If oFolder.Files.Count Then
        For Each oFile In oFolder.Files
            With oFile
                '輸出文件所在的盤符
                Dim sDrive As String
                sDrive = .Drive
                '輸出文件的類型
                Dim sType As String
                sType = .Type
                '輸出含后綴名的文件名稱
                Dim sName As String
                sName = .Name
                '輸出含文件名的完整路徑
                Dim sFilePath As String
                sFilePath = .Path
                '如果文件是Excel文件且不是隱藏文件
                If sType Like "*Excel*" And Not (sName Like "*~$*") Then
                    Set oWB1 = Excel.Workbooks.Open(sFilePath)
                    With oWB1
                        Set oWK1 = .Worksheets(1)
                        With oWK1
                            iRow = .Range("a65536").End(xlUp).Row
                            '***********************************
                            '其它操作代碼
                            '***********************************
                        End With
                        Excel.Application.Calculation = xlCalculationAutomatic
                        .Close
                    End With
                Else

                End If
            End With
        Next
    '如果指定的文件夾不含有文件
    Else
    End If
    '如果要遍歷子文件夾
    If bEnuSub = True Then
        '定義子文件夾集合對象
        Dim oSubFolders As Object
        Set oSubFolders = oFolder.SubFolders
        If oSubFolders.Count > 0 Then
            For Each oTempFolder In oSubFolders
                sTempPath = oTempFolder.Path
                Call EnuAllFiles(sTempPath, True)
            Next
        End If
        Set oSubFolders = Nothing
    End If
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Sub
Function GetPath() As String
    '聲明一個FileDialog對象變量
    Dim oFD As FileDialog
'    '創(chuàng)建一個選擇文件對話框
'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    '創(chuàng)建一個選擇文件夾對話框
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    '聲明一個變量用來存儲選擇的文件名或者文件夾名稱
    Dim vrtSelectedItem As Variant
    With oFD
        '允許選擇多個文件
        .AllowMultiSelect = True
        '使用Show方法顯示對話框，如果單擊了確定按鈕則返回-1。
        If .Show = -1 Then
            '遍歷所有選擇的文件
            For Each vrtSelectedItem In .SelectedItems
                '獲取所有選擇的文件的完整路徑,用于各種操作
                GetPath = vrtSelectedItem
            Next
            '如果單擊了取消按鈕則返回0
        Else
        End If
    End With
    '釋放對象變量
    Set oFD = Nothing
End Function
Function GetFileName(ByVal sName As String)
    '獲取不含后綴符的純文件名的自定義函數(shù)
    Dim sTemp As String
    sTemp = sName
    '判斷后綴名分隔符.的位置
    iPos = Len(sTemp) - VBA.InStr(1, VBA.StrReverse(sTemp), ".")
    If iPos <> 0 Then
        sTemp = Mid(sTemp, 1, iPos)
    End If
    '判斷路徑分隔符\的位置
    iPos = VBA.InStr(1, sTemp, "\")
    If iPos <> 0 Then
        '反轉(zhuǎn)后好取字符
        iPos = VBA.InStr(1, VBA.StrReverse(sTemp), "\")
        sTemp = Mid(VBA.StrReverse(sTemp), 1, iPos - 1)
        sTemp = VBA.StrReverse(sTemp)
    End If
    GetFileName = sTemp
End Function

4、總結(jié)

以上介紹的三種方法基本涵蓋了所有的在不同excel工作簿之間的讀寫數(shù)據(jù)的情況。

以上介紹的三種方法在讀寫其它excel工作簿的數(shù)據(jù)時，本質(zhì)上都是用Workbooks對象的Open方法先打開要讀寫的excel工作簿，然后再進(jìn)行操作。

二、用ADO連接excel工作簿不打開讀取法

上文中我們介紹了用Workbooks對象的Open方法打開具體的excel工作簿進(jìn)行讀寫的操作，這種方法可以適應(yīng)各種情況，但是效率較低，接下來介紹用ADO連接excel工作簿不打開直接讀取法。

1、用ado讀取當(dāng)前工作簿的方法：

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    Dim oRecrodset As Object
    Dim oConStr  As Object
    Dim sSql As String
    '寫SQL語句
    sSql = "select * from [Sheet1$]"
    Dim sConStr As String
    Dim sVersion  As String
    Dim oWk As Worksheet
    Set oWk = ThisWorkbook.Worksheets.Add
    sVersion = Excel.Application.Version
    '創(chuàng)建連接字符串
    If sVersion <= 12 Then
        sConStr = "Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" & Excel.ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES'"
    Else
        sConStr = "Provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & Excel.ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES'"
    End If
    Debug.Print sConStr
    Set oConStr = CreateObject("ADODB.Connection")
    '使用Connection連接數(shù)據(jù)源，并用Execute方法執(zhí)行對應(yīng)的SQL語句生成Recrodset對象
    With oConStr
        .Open sConStr
        Set oRecrodset = .Execute(sSql)
    End With
    With oRecrodset
        '循環(huán)導(dǎo)入字段名
        For i = 1 To .Fields.Count
            oWk.Cells(1, i) = .Fields(i - 1).Name
        Next
        oWk.Cells(2, 1).CopyFromRecordset oRecrodset
    End With
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
    Excel.Application.ScreenUpdating = True
    Set oConStr = Nothing
    Set oRecrodset = Nothing
End Sub

2、用ado讀取固定路徑工作簿的方法：

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    Dim oRecrodset As Object
    Dim oConStr  As Object
    Dim sFilePath As String
    '固定鏈接
    sFilePath = Excel.ThisWorkbook.Path & "\test.xlsx"
    Dim sSql As String
    '寫SQL語句
    sSql = "select * from [Sheet1$]"
    Dim sConStr As String
    Dim sVersion  As String
    Dim oWk As Worksheet
    Set oWk = ThisWorkbook.Worksheets.Add
    sVersion = Excel.Application.Version
    '創(chuàng)建連接字符串
    If sVersion <= 12 Then
        sConStr = "Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" & sFilePath & ";Extended Properties='Excel 8.0;HDR=YES'"
    Else
        sConStr = "Provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & sFilePath & ";Extended Properties='Excel 12.0;HDR=YES'"
    End If
    Debug.Print sConStr
    Set oConStr = CreateObject("ADODB.Connection")
    '使用Connection連接數(shù)據(jù)源，并用Execute方法執(zhí)行對應(yīng)的SQL語句生成Recrodset對象
    With oConStr
        .Open sConStr
        Set oRecrodset = .Execute(sSql)
    End With
    With oRecrodset
        '循環(huán)導(dǎo)入字段名
        For i = 1 To .Fields.Count
            oWk.Cells(1, i) = .Fields(i - 1).Name
        Next
        oWk.Cells(2, 1).CopyFromRecordset oRecrodset
    End With
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
    Excel.Application.ScreenUpdating = True
    Set oConStr = Nothing
    Set oRecrodset = Nothing
End Sub