Ⅰ excel中怎样读取另一个文件
第一种方法:打开另一个文件,,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]
总结:这种方法,不用再打开选择的文件,但是,利用引用的方式显示另一个文件的内容,显得有些藕断丝连,不方便.
第三种方法:利用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]
总结:感觉还是这种方式比较好~