Ⅰ 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]
總結:感覺還是這種方式比較好~