使用VBA读取EXCEL:

 

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

 

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

 


1. Public Sub Source做成()   
2.   
3. '声明Excel相关   
4.     Dim xlApp As Excel.Application   
5.     Dim xlBook As Excel.Workbook   
6.        
7.     Set xlApp = New Excel.Application   
8. '获取指定excel文件   
9. "C:/test.xls")   
10.   
11.     Dim sheet As Excel.Worksheet   
12. '获取指定sheet   
13. 2)   
14.        
15.     Dim ss As String   
16. '获取指定单元格的内容   
17. 2, 2)   
18.        
19. '内容显示   
20.     MsgBox (ss)   
21.      
22. 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