高分求助 excel高手请进

Question

假设有一个表格1，BCD列中的内容为A列的对应信息
A B C D(列)
张 1 2 3
王 4 5 6
赵 7 8 9
新建另一个表格2，表格中有三个工作簿，分别叫“张、王、赵”
有没有办法能让表格1中张王赵的相关信息直接对应到表格2的相应工作簿中
说更具体一点。假设【表格1】的“sheet1”中有如下内容（sheet2，sheet3空白）
A B C D(列)
张 1 2 3
王 4 5 6
赵 7 8 9
【表格2】中有“sheet1”“sheet2”“sheet3”3个工作簿，将这三个工作簿分别重命名为“张”“王”“赵”，即【表格2】的工作簿名称与【表格1】的A列内容相同且顺序一致。有没有一种办法能使【表格1】的内容自动对应到【表格2】的相应工作簿中，即工作簿“张”中出现“1、2、3”，“王”中出现“4、5、6”，“赵”中出现“7、8、9”，并且可以对所有工作簿统一操作，而不用逐个插入函数。因为工作簿非常多，逐个粘贴或插公式非常不便。谢谢大家的帮忙，如答案满意可再加100分

Answer 1

1、打开“开发工具”选项卡，excel2007的操作如下：
左上角office按钮=》excel选项=》常用=》在“在功能区显示“开发工具”选项卡”打钩。然后确定
2、进入VBA编辑界面：
在excel窗口中，菜单=》开发工具=》visual basic
3、在VBA界面中按以下步骤贴代码：
菜单=》插入=》模块（建议将模块放在personal.xlsb下面，这样以后也可以用，如果放在当前excel中，则关闭excel时需要保存为带宏的excel文件，否则以后这段程序将不可用）
将下面代码贴到右边的空白区域，保存

Sub 对应()
Dim sht As Worksheet
Application.Workbooks.Open Filename:="C:\Documents and Settings\lhk\桌面\表格1"
'如果表格1没有打开，则需要将路径放在这里，程序会自动打开

Workbooks("表格2").Sheets("sheet1").Activate
'先删除sheet2和sheet3
For Each sht In Sheets
If sht.Name <> ActiveSheet.Name Then sht.Delete
Next sht

Dim i, y As Integer
y = Workbooks("表格1").Sheets("sheet1").UsedRange.Rows.Count
'先将第一行对应过来
Workbooks("表格2").Sheets("sheet1").Name = Workbooks("表格1").Sheets("sheet1").Cells(1, 1)
ActiveSheet.Cells(1, 1) = Workbooks("表格1").Sheets("sheet1").Cells(1, 2)
ActiveSheet.Cells(1, 2) = Workbooks("表格1").Sheets("sheet1").Cells(1, 3)
ActiveSheet.Cells(1, 3) = Workbooks("表格1").Sheets("sheet1").Cells(1, 4)
'后面每一行处理时新建一个sheet，把数据对应过去
For i = 2 To y
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = Workbooks("表格1").Sheets("sheet1").Cells(i, 1)
ActiveSheet.Cells(1, 1) = Workbooks("表格1").Sheets("sheet1").Cells(i, 2)
ActiveSheet.Cells(1, 2) = Workbooks("表格1").Sheets("sheet1").Cells(i, 3)
ActiveSheet.Cells(1, 3) = Workbooks("表格1").Sheets("sheet1").Cells(i, 4)
Next

End Sub

'代码测试过，绝对可用，你可以根据自己的需要做适当修改，另“'”后面为注释，可以直接贴过去

4、可以直接在VBA里执行，也可以关掉VBA，在excel界面里通过宏来执行：菜单=》开发工具=》宏，然后选择 对应的宏 就可以了

Answer 2

用VBA
按ALT+F11键打开，菜单－插入－模块－右边空白处粘贴以下代码－按F5键完成
Sub chaifen()
Dim clm_d As Integer
Dim mycell As Range
Dim Nodupes As New Collection
Dim rngOp As Range
Dim Sht As Worksheet, ShtOp As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set ShtOp = ActiveSheet

For Each Sht In Sheets
If Sht.Name <> ActiveSheet.Name Then Sht.Delete
Next Sht
clm_d = 1
On Error Resume Next
For Each mycell In ShtOp.Range(Cells(2, clm_d), (ShtOp.Cells(2, clm_d).End(xlDown)))
Nodupes.Add mycell.Value, CStr(mycell.Value)
Next mycell
On Error GoTo 0
'''''''''''''''''''
Set rngOp = Cells.CurrentRegion
For Each Item In Nodupes
rngOp.AutoFilter clm_d, Criteria1:=Item
rngOp.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = Item
ActiveSheet.Paste
Columns("a:i").AutoFit
Columns("a:b").ColumnWidth = 8.5
[a2].Select
Next Item
rngOp.AutoFilter
ShtOp.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 3

假设张、王、赵工作表的A列为姓名，则可分别在三个工作表的b2单元格中用公式：
=vlookup($a2,[表格1.xls]sheet1!$a:$d,column(b1),)
右拉复制公式即可。

Answer 4

先排序表格1按你要分表的标准，如按姓名发就按A列排，否则....。
在表张中A1输入=表格1！A？就是你想在表格张中要的那行。横向复制公式至最后一列，再选中整行下拉复制公式至最后表张中的一行。叙述的有点乱，慢慢理解吧，其实很简单。

Answer 5

比较好地方法是VBA(森林浴1没仔细看)
实现根据第一个Sheet, 自动按要求完成其余sheet的填充,且可反复使用
难度较大, 可自己研究(录制后分析代码即可)

Answer 6

最好理解，容易操作的就是先按照A列排序，然后把归到一起数据分别复制到相应的表