VBA读取Excel和CSV

使用VBA读取EXCEL：

打开一个Excel文件，选择菜单栏上的"Tools"选项->Macro->Visual Basic Editor，打开VBA编辑器。

在Modules文件夹下的csMain文件中，写下如下VB格式的代码：

Public Sub Source做成()

'声明Excel相关

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Set xlApp = New Excel.Application

'获取指定excel文件

Set xlBook = xlApp.Workbooks.Open("C:/test.xls")

Dim sheet As Excel.Worksheet

'获取指定sheet

Set sheet = xlBook.Worksheets(2)

Dim ss As String

'获取指定单元格的内容

ss = sheet.Cells(2, 2)

'内容显示

MsgBox (ss)

End Sub

***********************vba 在excel 读取自动筛选下拉菜单的数据[b]***********************[/b]

从以下的示例中，以及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