VBA讀取Excel和CSV

使用VBA讀取EXCEL：

打開一個Excel檔案，選擇菜單欄上的"Tools"選項->Macro->Visual Basic Editor，打開VBA編輯器。

在Modules檔案夾下的csMain檔案中，寫下如下VB格式的代碼：

1. Public Sub Source做成()   
2. '聲明Excel相關   
3.     Dim xlApp As Excel.Application   
4.     Dim xlBook As Excel.Workbook   
5.     Set xlApp = New Excel.Application   
6. '擷取指定excel檔案   
7.     Set xlBook = xlApp.Workbooks.Open("C:/test.xls")   
8.     Dim sheet As Excel.Worksheet   
9. '擷取指定sheet   
10.     Set sheet = xlBook.Worksheets(2)   
11.     Dim ss As String   
12. '擷取指定單元格的内容   
13.     ss = sheet.Cells(2, 2)   
14. '内容顯示   
15.     MsgBox (ss)   
16. End Sub  

***********************vba 在excel 讀取自動篩選下拉菜單的資料***********************

從以下的示例中，以及FILTE這個對象的屬性來看，無法周遊篩選列出的項目。我覺的可以換個方法，例如生成透視表，再周遊透視表中的值，然後再删除透視表。

Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String

Sub ChangeFilters()

Set w = Worksheets("Crew")
With w.AutoFilter
    currentFiltRange = .Range.Address
    With .Filters
        ReDim filterArray(1 To .Count, 1 To 3)
        For f = 1 To .Count
            With .Item(f)
                If .On Then
                    filterArray(f, 1) = .Criteria1
                    If .Operator Then
                        filterArray(f, 2) = .Operator
                        filterArray(f, 3) = .Criteria2
                    End If
                End If
            End With
        Next
    End With
End With

w.AutoFilterMode = False
w.Range("A1").AutoFilter field:=1, Criteria1:="S"

End Sub      

***************使用Vba讀取已關閉的Excel工作薄資料到目前工作表單元格之簡單範例***************      

VBA功能強大，用途廣泛，值得研究學習！

　　本文介紹如題所示的操作過程；

　　範例環境：

　　在F:/盤根目錄下，存在一工作薄，名稱為“成績表.xls”，其對應的路徑是：“F:/成績表.xls”；

　　該工作薄第一個工作表名稱是：Sheet1，裡面存放的是學生期末考試成績，其中，E列從E3開始，就是學生的考試成績；

　　下面我們要實作的是，在關閉F:/成績表.xls情況下，打開Excel軟體，建立一工作薄，在其工作表中的指定單元格，讀取F:/成績表.xls中的指定的成績資料進行填充；

　　①：在建立的工作表中直接按下組合鍵：Alt F11，打開Microsoft Visual Basic視窗；如果打開的視窗沒有出現代碼視窗，那麼，請在目前視窗執行操作：“視圖”→“代碼視窗”；

　　②：在代碼視窗中輸入如下的代碼：

Private Function GetValue(path, filename, sheet, ref)

' 從關閉的工作薄傳回值

Dim MyPath As String

'确定檔案是否存在

If Right(path, 1) & Range(ref).Range("A1").Address(, , xlR1C1)

'執行EXCEL4宏函數

GetValue = Application.ExecuteExcel4Macro(MyPath)

End Function

'函數參數說明

'-----------------------------------------------------------------

'path：檔案路徑

'filename：檔案名稱

'sheet：工作表名稱

'ref： 單元格區域

'-----------------------------------------------------------------

Sub GetCloseXlsValue()

Range("C3").Value = GetValue("F:/", "成績表.xls", "Sheet1", "E8")

End Sub

　　上述代碼的功能是：讀取F:/成績表.xls中E8單元格的資料填充到目前EXCEL的C3單元格中；

　　上述代碼的诠釋已做說明，不再闡述！

　　之後直接按下F5運作代碼，或點選代碼運作按鈕執行代碼的操作，傳回EXCEL視窗，即可看到填充效果；

　　知識擴充：

　　如何對關閉的工作薄資料進行求和再填充到目前工作表？

　　可将Range("C3").Value = GetValue("F:/", "成績表.xls", "Sheet1", "E8")

　　改為：Range("C3").Value = GetValue("F:/", "成績表.xls", "Sheet1", "E8") GetValue("F:/", "成績表.xls", "Sheet1", "E9") GetValue("F:/", "成績表.xls", "Sheet1", "E10")

這樣，對E8,E9,E10三個單元格進行相加求和之後，再填充過來；

如果想填充其他單元格資料到目前工作表的其他單元格，隻需要修改來處即可：

　　①：Range("C3").Value ，修改C3

　　②：GetValue("F:/", "成績表.xls", "Sheet1", "E8")，修改盤符，檔案名，工作表名，E8單元格

　　如果想使用更智能的辦法，必須使用循環語句來控制，本例暫且不作介紹；

*****************************vba 讀取csv檔案*****************************

Const Title As String = "IMPORT CSV TEST"

Sub fMain()

    Dim fTextDir As String

    Dim pintLen As Integer

    Dim pstrValue As String

    Dim rowIndex As Integer

    Dim i As Integer

    rowIndex = 1

    pstrValue = ""

    pintLen = Len(Title) '标題長度

    fTextDir = "D:/status.csv" ' csv文本路徑

    Open fTextDir For Input As #1 ' 導入文本

    Do While Not EOF(1) '逐行循環

        Line Input #1, currLine '取第一行，并指派

        If Right(currLine, pintLen) = Title Then

        Range(Cells(rowIndex, 1), Cells(rowIndex, 4)).Select

         With Selection

            .HorizontalAlignment = xlCenter

            .VerticalAlignment = xlTop

            .WrapText = False

            .Orientation = 0

            .AddIndent = False

            .ShrinkToFit = False

            .ReadingOrder = xlContext

            .MergeCells = True

            .RowHeight = 27.75

            .Font.Name = "Arial"

            .Font.Size = 18

            .Font.Bold = True

            .FormulaR1C1 = Title

            .Interior.ColorIndex = 6

            .Interior.Pattern = xlSolid

        End With

        Else

        rowDataArr = Split(currLine, ",")

        For i = 0 To UBound(rowDataArr)

            Cells(rowIndex, i + 1).Select

            With Selection

                .HorizontalAlignment = xlCenter

                .VerticalAlignment = xlTop

                .WrapText = False

                .Orientation = 0

                .AddIndent = False

                .ShrinkToFit = False

                .ReadingOrder = xlContext

                .MergeCells = True

                .RowHeight = 20

                .Font.Name = "Arial"

                .Font.Size = 12

                .Font.Bold = False

                .FormulaR1C1 = rowDataArr(i)

            End With

        Next i

        End If

        rowIndex = rowIndex + 1

    Loop

    Close #1

End Sub