2010-09-23 60 views
1

我试图根据列D中的数据将Sheet'All'的整行复制到另一个工作表.D列(Homework/Advanced/Beginner)中有多个值,这些行需要复制有相应的名字。 (家庭作业到家庭作业页)如果条件满足,将excel中的行复制到表中。

工作表'全部'中的数据将被添加到并且新数据需要被复制而不复制已经存在的数据。

回答

1

这不是一个大问题。最好的办法是保持简单,并在“全部”变化时复制所有内容。我有一个“重新分配”按钮上的“全”片,并有事件调用scatterRows()

你不说你的源表的样子,所以我做的东西了对表“所有”:

9 0.181626294 carrot beginner Irene 
5 0.221180184 beans advanced Eva 
8 0.221813735 turnip advanced Harry 
10 0.314800867 lettuce homework John 
4 0.360163255 peas homework Doug 
11 0.379956592 pepper advanced Karen 
3 0.44415906 tomato beginner Charlie 
6 0.647446239 corn beginner Frank 
2 0.655706735 potato advanced Bob 
7 0.666002258 lentils homework George 
1 0.768524361 squash homework Alice 

该代码相当灵活;它会找到整个源块,因此,只要列“D”包含工作表键并且数据以A1(无标题)开始,那么无论您拥有多少列都无关紧要。如果您有标题,请将所有A1引用更改为A2。

其他床单(“家庭作业”等)必须已经创建。 - 并且您需要为Microsoft Scripting Runtime设置参考。

代码中唯一“有趣”的部分是计算出目标范围(putString)的字符串。

Option Explicit 

'' Copy rows from the "all" sheet to other sheets 
'' keying the sheetname from column D. 
'' **** Needs Tools|References|Microsoft Scripting Runtime 
'' Changes: 
''  [1] fixed the putString calculation. 
''  [2] Added logic to clear the target sheets. 

Sub scatterRows() 

    Dim srcRange As Range 
    Dim srcRow As Range 
    Dim srcCols As Integer 
    Dim srcCat As String 
    Dim putRow As Integer 
    Dim putString As String 
    Dim s      ''*New [2] 

    '' Current row for each category 
    Dim cats As Dictionary 
    Set cats = New Dictionary 
    cats.Add "homework", 0 
    cats.Add "beginner", 0 
    cats.Add "advanced", 0 

    '' Clear the category sheets *New [2] 
    For Each s In cats.Keys 
     Range(s & "!A1").CurrentRegion.Delete 
    Next s 

    '' Find the source range 
    Set srcRange = [all!a1].CurrentRegion 
    srcCols = srcRange.Columns.Count 

    '' Move rows from source Loop 
    For Each srcRow In srcRange.Rows 

     '' get the category 
     srcCat = srcRow.Cells(4).Value 

     '' get the target sheet row and increment it 
     putRow = cats(srcCat) + 1 
     cats(srcCat) = putRow 

     '' format the target range string  *Fixed [1] 
     '' e.g. "homework!A3:E3" 
     putString = srcCat & "!" & _ 
      [a1].Offset(putRow - 1, 0).Address & _ 
      ":" & [a1].Offset(putRow - 1, srcCols - 1).Address 

     '' copy from sheet all to target sheet 
     Range(putString).Value = srcRow.Value 
    Next srcRow 
End Sub 
+0

谢谢马克,我得到了'编译错误:用户定义类型未定义'指向'猫作为字典'我做错了什么? – 2010-09-24 14:19:58

+0

您需要Microsoft Scripting Runtime,Dictionary对象所在的位置。在VBA窗口中,单击工具|参考并向下滚动以选择Microsoft脚本运行时。字典是非常有用的,尽管我在这里做了相对简单的使用。这是你应该熟悉的工具之一。 – 2010-09-24 14:53:42

+0

谢谢马克,现在可以工作 - 如果我真的阅读说明会有所帮助 - 对不起 – 2010-09-24 15:21:53

相关问题