如果条件为，则将Excel中的行复制到工作表。 [英] Copy rows in excel to sheets if condition is .

问题描述

我想根据列D中的数据将工作表全部的所有行复制到另一个工作表中。列D（家庭作业/高级/初学者）中有多个值，这些行需要为复制到具有相应的名称。 （作业到家庭作业表）

I'm trying to copy entire rows of the Sheet ‘All’ to another sheet according to the data in column D. There are multiple values in column D (Homework/Advanced/Beginner) and the sheets these rows need to be copied to have corresponding names. (Homework to Homework sheet.)

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

The data in Sheet ‘All’ will be added on to and the new data needs to be copied without duplicating the ones that are already there.

推荐答案

这不是一个大问题。最好的事情是保持简单，每当所有更改时复制一切。我在所有表单上有一个重新分发按钮，并且调用了scatterRows（）

It's not a big problem. The best thing is to keep things simple and copy everything whenever "all" changes. I'd have a "Redistribute" button on the "all" sheet and have the event call scatterRows()

你不会说你的源代码表我为纸张全部做了一些：

You don't say what your source sheet looks like so I made something up for sheet "all":

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。

The code is fairly flexible; it finds the whole source block, so it doesn't matter how many columns you have as long as column "D" holds the sheet key and the data starts in A1 (no headings). If you have headings, change all the A1 references to A2.

其他工作表（作业等）必须已创建。 -

The other sheets ("homework" etc) must have been created. --And you need a reference set to the Microsoft Scripting Runtime.

代码的唯一有趣部分是找出目标范围的字符串（putString） 。

The only "interesting" part of the code is figuring out the string for the target range (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

这篇关于如果条件为，则将Excel中的行复制到工作表。的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！