excel中怎样读取另一个文件
='D:\MyDocuments\信用村\[03张三.xls]农户基本信息'!$B$3文件夹下的文件有03张三.xls，04李四.xls05.........要求要把信用...
='D:\My Documents\信用村\[03 张三.xls]农户基本信息'!$B$3
文件夹下的文件有03 张三.xls，04 李四.xls 05.........
要求要把信用村文件夹下的文件合并到一个文件夹里，读取的都是同一个位置，文件名不同，一个一个的输入太麻烦，有几千户，想用下拉方式，求方法。
目的是下一格中中的公式应该是
='D:\My Documents\信用村\[04 李四.xls]农户基本信息'!$B$3 展开
文件夹下的文件有03 张三.xls，04 李四.xls 05.........
要求要把信用村文件夹下的文件合并到一个文件夹里，读取的都是同一个位置，文件名不同，一个一个的输入太麻烦，有几千户，想用下拉方式，求方法。
目的是下一格中中的公式应该是
='D:\My Documents\信用村\[04 李四.xls]农户基本信息'!$B$3 展开
7个回答
展开全部
第一种方法:打开另一个文件,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]
总结:这种方法,不用再打开选择的文件,但是,利用引用的方式显示另一个文件的内容,显得有些藕断丝连,不方便.
第三种方法:利用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]
总结:感觉还是这种方式比较好~
触发按钮单机事件,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]
总结:感觉还是这种方式比较好~
本回答由电脑网络分类达人 孟男男推荐
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
Sub CombineWorkbooks()
Dim FilesToOpen, ft
Dim x As Integer
Application.ScreenUpdating = False
On Error GoTo errhandler
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Micrsofe Excel文件(*.xls;*.xlsx), *.xls;*.xlsx", _
MultiSelect:=True, Title:="要合并的文件")
If TypeName(FilesToOpen) = "boolean" Then
MsgBox ("没有选定文件")
End If
x = 1 :y=1 'x,y是你实际的写入的位置,x为行,y为列
Do While x <= UBound(FilesToOpen)
Set wk = Workbooks.Open(Filename:=FilesToOpen(x))
thisworkbook.sheets(1).cells(x,y)= wk.Sheets("农户基本信息").cells(3,2)
x = x + 1
Loop
MsgBox ("合并成功完成！")
errhandler:
End Sub
Dim FilesToOpen, ft
Dim x As Integer
Application.ScreenUpdating = False
On Error GoTo errhandler
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Micrsofe Excel文件(*.xls;*.xlsx), *.xls;*.xlsx", _
MultiSelect:=True, Title:="要合并的文件")
If TypeName(FilesToOpen) = "boolean" Then
MsgBox ("没有选定文件")
End If
x = 1 :y=1 'x,y是你实际的写入的位置,x为行,y为列
Do While x <= UBound(FilesToOpen)
Set wk = Workbooks.Open(Filename:=FilesToOpen(x))
thisworkbook.sheets(1).cells(x,y)= wk.Sheets("农户基本信息").cells(3,2)
x = x + 1
Loop
MsgBox ("合并成功完成！")
errhandler:
End Sub
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
用xplorer2（一个资源管理器，可以直接取得所有文件的文件名，包含路径和后缀。在网上可找到该软件）选择D:\My Documents\信用村下的所有文件（即你需要取信息的文件），然后用alt+c，取得所有文件的路径和文件名；
copy到一个一个文本文件（比如用ultraedit）中，会得到按行排列的“D:\My Documents\信用村\04 李四.xls”
用批量替换的方式给“04 李四.xls”两边加上[ ] 和“农户基本信息'!$B$3”，以及最前面的“=”.（这个不方法不用说了吧）。
然后把这个文本copy到你需要的excel表中即可。
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
解决方式：
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Sql$, Cnn As Object
On Error Resume Next
Set Cnn = CreateObject("ADODB.connection")
Set rs = CreateObject("adodb.recordset")
If Target.Column = 3 And Target.Value <> "" Then
Cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\资料列表.xls"
Sql = "select 物品重量,包装重量,进货价,发货方式,运费 from [Sheet1$] where 编号 like '" & Range("a" & Target.Row).Value & "'"
rs.Open Sql, Cnn, 1, 3
Target.Offset(0, 1) = rs.Fields("物品重量") + rs.Fields("包装重量")
Target.Offset(0, 2) = rs.Fields("进货价")
Target.Offset(0, 3) = rs.Fields("运费")
rs.Close
Cnn.Close
Else
MsgBox "请在第3列输入数据"
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim Sql$, Cnn As Object
On Error Resume Next
Set Cnn = CreateObject("ADODB.connection")
Set rs = CreateObject("adodb.recordset")
If Target.Column = 3 And Target.Value <> "" Then
Cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "\资料列表.xls"
Sql = "select 物品重量,包装重量,进货价,发货方式,运费 from [Sheet1$] where 编号 like '" & Range("a" & Target.Row).Value & "'"
rs.Open Sql, Cnn, 1, 3
Target.Offset(0, 1) = rs.Fields("物品重量") + rs.Fields("包装重量")
Target.Offset(0, 2) = rs.Fields("进货价")
Target.Offset(0, 3) = rs.Fields("运费")
rs.Close
Cnn.Close
Else
MsgBox "请在第3列输入数据"
End If
Application.EnableEvents = True
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
插入，对象或者附件。
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
Sub
CombineWorkbooks()
Dim
FilesToOpen,
ft
Dim
x
As
Integer
Application.ScreenUpdating
=
False
On
Error
GoTo
errhandler
FilesToOpen
=
Application.GetOpenFilename
_
(FileFilter:="Micrsofe
Excel文件(*.xls;*.xlsx),
*.xls;*.xlsx",
_
MultiSelect:=True,
Title:="要合并的文件")
If
TypeName(FilesToOpen)
=
"boolean"
Then
MsgBox
("没有选定文件")
End
If
x
=
1
:y=1
'x,y是你实际的写入的位置,x为行,y为列
Do
While
x
<=
UBound(FilesToOpen)
Set
wk
=
Workbooks.Open(Filename:=FilesToOpen(x))
thisworkbook.sheets(1).cells(x,y)=
wk.Sheets("农户基本信息").cells(3,2)
x
=
x
+
1
Loop
MsgBox
("合并成功完成！")
errhandler:
End
Sub
CombineWorkbooks()
Dim
FilesToOpen,
ft
Dim
x
As
Integer
Application.ScreenUpdating
=
False
On
Error
GoTo
errhandler
FilesToOpen
=
Application.GetOpenFilename
_
(FileFilter:="Micrsofe
Excel文件(*.xls;*.xlsx),
*.xls;*.xlsx",
_
MultiSelect:=True,
Title:="要合并的文件")
If
TypeName(FilesToOpen)
=
"boolean"
Then
MsgBox
("没有选定文件")
End
If
x
=
1
:y=1
'x,y是你实际的写入的位置,x为行,y为列
Do
While
x
<=
UBound(FilesToOpen)
Set
wk
=
Workbooks.Open(Filename:=FilesToOpen(x))
thisworkbook.sheets(1).cells(x,y)=
wk.Sheets("农户基本信息").cells(3,2)
x
=
x
+
1
Loop
MsgBox
("合并成功完成！")
errhandler:
End
Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
更多回答（5）
推荐律师服务：
若未解决您的问题，请您详细描述您的问题，通过百度律临进行免费专业咨询
|
广告 您可能关注的内容 |
