求几句赋值语句

zhouyuma · 发表于 2017-1-21 18:06

本帖最后由 zhouyuma 于 2017-1-21 18:06 编辑

有几个赋值语句找不到，请会的师傅帮个忙，先谢谢了
   经常做这样的文件：软件导出的表（源表)格式为后面的Sheet1～Sheet3（数量不一定是3个)，而要求上报的表（目标表)格式为前面四个表（数量不一定就四个)，因为要把后面源表中的单价复制，粘贴到对应的目标表中，源表与目标表行的数量不一样，所以想搞个代码
   我要的代码：（不是全部，我自己再组装）：
   1、输入目标表及源表名称：第二个表,Sheet1（可修改,默认傎为第二个表及Sheet1，因前面的目标表名称及数量会因不同文件而不同，后面的表为Sheet1～SheetM,表名在运行代码前全部确定了）
   2、如输入的表名在文件中找不到，重新输入或点“×”或“取消”退出代码，（防止输入工作表名出错）
   3、a=目标表中序号（在B列）最大的傎（本文件中第一次为a=803，本文件中这个代码要用三次）
   4、b=源表中的序号（在A列）最大的傎（本文件中第一次为b=803）
   5、c=目标表序号为N的行号（N为变量，N = 1 to a）

sandorn · 发表于 2017-1-23 12:00

Sub 浏览指定类型的文件名称() '后面的代码自己添加
On Error Resume Next
'指定源表
Dim fileToOpen
fileToOpen = Application.GetOpenFilename("Excel文件 (*.xl*), *.xl*", , "请选择Excel文件", , False)
Dim bok As Workbook, source As Worksheet
Set bok = Workbooks.Open(fileToOpen)
Set source = bok.Sheets(1) '指定源表
bbb = Application.Max(source.Columns("A")) ' 4、b=源表中的序号（在A列）最大的傎（本文件中第一次为b=803）
'指定目标表
Dim fileToOpen1
fileToOpen1 = Application.GetOpenFilename("Excel文件 (*.xl*), *.xl*", , "请选择Excel文件", , False)
Dim bok1 As Workbook, source1 As Worksheet
Set bok1 = Workbooks.Open(fileToOpen1)
Set source1 = bok1.Sheets(1) '指定目标表
aaa = Application.Max(source1.Columns("B")) '3、a=目标表中序号（在B列）最大的傎（本文件中第一次为a=803，本文件中这个代码要用三次）
'任务代码
For i = 1 To aaa
With source1.Columns("B")
Set cR = .Find(i, LookIn:=xlValues)
If Not cR Is Nothing Then
CCC = cR.Row '5、c=目标表序号为N的行号（N为变量，N = 1 to a）
End If
End With
Next
'其他代码
bok.Close '关闭文件
bok1.Close '关闭文件
End Sub

复制代码

		自动登录	找回密码
密码			注册