Значения Excel на разных листах

#excel #vba

#excel #vba

Вопрос:

У меня есть лист Excel, подобный приведенному ниже

Название листа: Raw

Данные:

  1. Синее значение1 значение2 значение3 значение4
  2. Зеленое значение5 значение6 значение7 значение8
  3. Черное значение9 значение10 значение11 значение12
  4. Синее значение13 значение14 значение15 значение16
  5. Зеленое значение17 значение18 значение19 значение20 . . .

Я хочу автоматически создавать разные листы с именами Blue, Green, Black и добавлять туда эти строки. Итак, я хотел бы иметь:

Название листа: Blue

  1. Синее значение1 значение2 значение3 значение4
  2. Синее значение13 значение14 значение15 значение16

Название листа: зеленый

  1. Зеленое значение5 значение6 значение7 значение8
  2. Зеленое значение17 значение18 значение19 значение20

Название листа: Черный

  1. Черное значение9 значение10 значение11 значение12

Есть идеи?

Комментарии:

1. Не имеет строгого отношения к кодированию, возможно, принадлежит superuser.com

2. Это зависит от того, как вы можете реализовать решение

3. @Gary Для этого, скорее всего, потребуется решение vba, здесь, вероятно, все в порядке. @ Midis Тем не менее, что вы уже пробовали, или вы просто просите кого-нибудь закодировать это для вас?

4. Я пытался сделать это с помощью perl, но меня попросили сделать это более простым способом, чтобы его можно было повторно использовать в моей работе. Я не знаю Excel или vba, и именно поэтому я спрашиваю. Я не хочу, чтобы кто-то кодировал это за меня. Я хочу услышать мнение… Прекратите комментировать без причины. Если вы не знаете, вы не знаете

5. Этот вопрос был перекрестно размещен на superuser.com как [ superuser.com/questions/278913 /…

Ответ №1:

Вот небольшая процедура, которая поможет вам начать…

 Sub CopyColorRows()
    Dim wb As Workbook
    Dim shData As Worksheet
    Dim shBlue As Worksheet, shGreen As Worksheet, shBlack As Worksheet
    Dim rw As Range

    Set wb = ActiveWorkbook
    Set shData = wb.Sheets("Data")

    Application.DisplayAlerts = False
    On Error Resume Next

    Set shBlue = wb.Sheets("Blue")
    If Err.Number <> 0 Then
        Err.Clear
    Else
        shBlue.Delete
    End If
    Set shBlue = wb.Sheets.Add
    shBlue.Name = "Blue"

    Set shGreen = wb.Sheets("Green")
    If Err.Number <> 0 Then
        Err.Clear
    Else
        shGreen.Delete
    End If
    Set shGreen = wb.Sheets.Add
    shGreen.Name = "Green"

    Set shBlack = wb.Sheets("Black")
    If Err.Number <> 0 Then
        Err.Clear
    Else
        shBlack.Delete
    End If
    Set shBlack = wb.Sheets.Add
    shBlack.Name = "Black"

    Application.DisplayAlerts = False
    On Error GoTo 0

    For Each rw In shData.UsedRange.Rows
        Select Case rw.Cells(1, 1)
        Case "Blue"
            rw.Copy shBlue.UsedRange.Offset(1, 0)
        Case "Green"
            rw.Copy shGreen.UsedRange.Offset(1, 0)
        Case "Black"
            rw.Copy shBlack.UsedRange.Offset(1, 0)
        End Select
    Next
End Sub