Скопируйте строки в Excel в листы, если условие выполнено.

Question

Я пытаюсь скопировать все строки листа «Все» на другой лист в соответствии с данными в столбце D. В столбце D есть несколько значений (Домашняя работа / Дополнительно / Начинающий), и на листах эти строки должны быть скопированы, чтобы иметь соответствующие имена. (Домашнее задание к домашнему заданию.)

Данные в листе «Все» будут добавлены, и новые данные должны быть скопированы без дублирования уже существующих.

Answer 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