<em>excel</em>中读取另一<em>excel</em>中的文

方法：抄

1、常用读取数据多用VlookUP函数。

2、打开两个EXCEL表格，在第二百个表格中输入：度=VLOOKUP(A:A,[Book1]Sheet1!$A$1:$B$7,2,FALSE)

3、这时，函数会自动提取相同的数值，如图。

4、如果直接引知用，可以道在第二个表格输入=[Book1]Sheet1!$A$2即可。

在B4单元格输入以下公式，然后向zd下填充公式
=VLOOKUP(A4,INDIRECT("'["&B$1&"*.xls]Sheet1!'A:B"),2,0)
公式表示：通过INDIRECT函数，内引用"'["&B$1&"*.xls]Sheet1!'A:B"字符串构成的查找引用区域，并通过VLOOKUP函数在其A列精确匹配与容A4单元格相同的单元格，并返回对应B列的数据。
这个需要表名字固定，工作簿名称固定，然后是工作簿所在文件夹固定。其中有一个变化就需要变化。使用定义名称加上公式可以实现。

第一种方法:打开另一个文件,copy,paste:
触发按钮单机事件,VBA如下:
[code=vb]
Private Sub CommandButton1_Click()
Dim towb As Workbook
Dim tows As Worksheet
Dim torow As Integer
Dim fromwb As Workbook
Dim fromws As Worksheet
Dim fromrow As Integer
Dim projectname

Dim i
Dim openfiles 'input the filepath of your selection

Set towk = Application.ActiveWorkbook
Set tows = ActiveSheet
torow = [a65536].End(3).Row + 1 'get the last row of data by column A
'get the active worksheet

'call openfile function
openfiles = openfile()
If openfiles <> "" Then
Set fromwb = Application.Workbooks.Open(openfiles)
Set fromws = fromwb.Sheets("IPIS")

'set ID
tows.Activate
tows.Cells(torow, 1) = tows.Cells(torow - 1, 1) + 1

'set "Go/No Go"
tows.Activate
tows.Cells(torow, 2) = "Go"

'set "Project Name"
fromwb.Activate
fromws.Activate
fromws.Cells(5, 1).Select
Selection.Copy
tows.Activate
tows.Cells(torow, 7).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

projectname = tows.Cells(torow, 7)

'set "Customer" by projectname
tows.Activate
tows.Cells(torow, 4) = Split(projectname, " ", 2)(0)

' range（"A1"） Like "*1234*"

End If
towk.Activate
End Sub
Function openfile() As Variant

'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
'of each selected item. Even though the path is aString,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
'Allow the selection of multiple files.
.AllowMultiSelect = True
'Use the Show method to display the file picker dialog and return the user's action.
'If the user presses the button...
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem is aString that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example displays the path in a message box.
MsgBox "Selected item's path: " & vrtSelectedItem
openfile = vrtSelectedItem

Next
'If the user presses Cancel...
Else
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing

End Function
[/code]

总结:这种方法可以实现,但是需要打开对应的选择文件才行.
第二种方法:利用引用来显示另一个表的内容,不打开文件,VBA代码如下:
触发按钮单机事件:
[code=vb]
Private Sub CommandButton1_Click()
Dim towb As Workbook
Dim tows As Worksheet
Dim torow As Integer
Dim fromwb As Workbook
Dim fromws As Worksheet
Dim fromrow As Integer
Dim projectname

Dim i
Dim openfiles 'input the filepath of your selection
Dim filename

Set towk = Application.ActiveWorkbook
Set tows = ActiveSheet
torow = [a65536].End(3).Row + 1 'get the last row of data by column A
'get the active worksheet

Application.ScreenUpdating = False 'call openfile function
openfiles = openfile()
If openfiles <> "" Then
'Set fromwb = Application.Workbooks.Open(openfiles)
'Set fromws = fromwb.Sheets("IPIS")

'set ID
tows.Activate
tows.Cells(torow, 1) = tows.Cells(torow - 1, 1) + 1

'set "Go/No Go"
tows.Activate
tows.Cells(torow, 2) = "Go"

'set "Project Name"
filename = dealstr(openfiles)
ActiveSheet.Cells(torow, 7).Formula = "='" & filename & "IPIS'!$A$5"
projectname = tows.Cells(torow, 7)

'set "Customer" by projectname
tows.Activate
tows.Cells(torow, 4) = Split(projectname, " ", 2)(0)

' range（"A1"） Like "*1234*"

End If
towk.Activate
Application.ScreenUpdating = True
End Sub
Function dealstr(f As Variant) As Variant
Z = Len(f)
For ii = Z To 1 Step -1
If Mid(f, ii, 1) = "\" Then
Exit For
End If
Next ii
For i = Len(f) To y Step -1
If Mid(f, i, 1) <= "z" Then
Exit For
End If
Next i
a = Mid(f, ii + 1, i - ii)
b = Mid(f, 1, ii)
dealstr = b & "[" & a & "]"
End Function
Function openfile() As Variant

'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
'of each selected item. Even though the path is aString,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
'Allow the selection of multiple files.
.AllowMultiSelect = True
'Use the Show method to display the file picker dialog and return the user's action.
'If the user presses the button...
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem is aString that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example displays the path in a message box.
openfile = vrtSelectedItem

Next
'If the user presses Cancel...
Else
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing

End Function
[/code]
总结:这种方法,不用再打开选择的文件,但是,利用引用的方式显示另一个文件的内容,显得有些藕e79fa5e98193e4b893e5b19e337断丝连,不方便.
第三种方法:利用ExecuteExcel4Macro,不打开文件就能读取内容,不再是引用的关系,VBA代码如下:
触发按钮单机事件:
[code=vb]Private Sub CommandButton1_Click()
Dim towb As Workbook
Dim tows As Worksheet
Dim torow As Integer
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i As Integer
Dim SQL As String, cnnStr As String, sFileName As String
Dim wb As Workbook
Dim ws As Worksheet

Dim projectname

Dim openfiles 'input the filepath of your selection
Dim filename

Set towk = Application.ActiveWorkbook
Set tows = ActiveSheet
torow = [a65536].End(3).Row + 1 'get the last row of data by column A
'get the active worksheet

Application.ScreenUpdating = False 'call openfile function
openfiles = openfile()
If openfiles <> "" Then
If GetValue(getpathname(openfiles), getfilename(openfiles), "IPIS", "A2") = "error" Then
MsgBox "选取文件有误"
Else
'set ID
tows.Activate
tows.Cells(torow, 1) = tows.Cells(torow - 1, 1) + 1

'set "Go/No Go"
tows.Activate
tows.Cells(torow, 2) = "Go"

'set "Project Name"
tows.Cells(torow, 7) = GetValue(getpathname(openfiles), getfilename(openfiles), "IPIS", "A5")

projectname = tows.Cells(torow, 7)

'set "Customer" by projectname
tows.Activate
tows.Cells(torow, 4) = Split(projectname, " ", 2)(0)
End If
End If

Application.ScreenUpdating = True
End Sub

Private Function GetValue(path, filename, sheet, ref)
' 从关闭的工作薄返回值
Dim MyPath As String
'确定文件是否存在
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & filename) = "" Then
GetValue = "error"
Exit Function
End If
'创建公式
MyPath = "'" & path & "[" & filename & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
'执行EXCEL4宏函数
GetValue = Application.ExecuteExcel4Macro(MyPath)
End Function

Function openfile() As Variant

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is aString,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Allow the selection of multiple files.
.AllowMultiSelect = True

'Use the Show method to display the file picker dialog and return the user's action.
'If the user presses the button...
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is aString that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example displays the path in a message box.
openfile = vrtSelectedItem
Next
'If the user presses Cancel...
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Function

Function getfilename(f As Variant) As Variant
Z = Len(f)
For ii = Z To 1 Step -1
If Mid(f, ii, 1) = "\" Then
Exit For
End If
Next ii
For i = Len(f) To y Step -1
If Mid(f, i, 1) <= "z" Then
Exit For
End If
Next i
getfilename = Mid(f, ii + 1, i - ii)
End Function
Function getpathname(f As Variant) As Variant
Z = Len(f)
For ii = Z To 1 Step -1
If Mid(f, ii, 1) = "\" Then
Exit For
End If
Next ii
For i = Len(f) To y Step -1
If Mid(f, i, 1) <= "z" Then
Exit For
End If
Next i
getpathname = Mid(f, 1, ii)
End Function
[/code]
总结:感觉还是这种方式比较好~