Автоматически передавать данные при определенных условиях - PullRequest
1 голос
/ 07 февраля 2012

Я впервые использую этот веб-сайт, и я был бы очень признателен, если бы кто-нибудь помог мне написать код для макроса в Excel, чтобы выполнить следующие действия.

Положение:

  1. У меня есть 8 листов данных, которые называются Data A, Data B, ..., Data H.
  2. У меня есть 1 сводная таблица под названием Summary.
  3. На каждом из 8 листов данных имеется n количество идентификаторов из ячейки C8 и по горизонтали (т. Е. C8, D8, E8, ...).
  4. Каждый идентификатор имеет связанные данные под ячейками по вертикали. (т. е. идентификатор в ячейке C8 имеет соответствующие данные для C9, C10, C13, C14, C15).

Чтобы сделать:

  1. После активации макроса перейдите к Data A, начните с C8, чтобы проверить, пуста ли ячейка или нет.
  2. Если ячейка не пуста, скопируйте идентификатор (комбинацию строк и чисел) в ячейку C8 вместе с соответствующими данными из (C9 до C10) и (C13 до C15) в Summary лист в (A1 до A6).
  3. После копирования перейдите к следующей ячейке, которая является D8 на листе Data A, повторите шаг 2. На этот раз местом назначения копирования будет B1 до B6 на листе Summary.
  4. В любой момент, если ячейка в строке 8 на листе Data A пуста, переходите к следующему листу данных (Data B).
  5. Повторяйте шаги 2, 3 и 4, пока на листе Data H не будет найдена пустая ячейка.

Я надеюсь, что смогу найти кого-нибудь, кто сможет это сделать.

Вот что у меня есть (пожалуйста, поймите, я новичок в VBA):

Dim ws As Worksheet

Dim r As Integer

    For Each ws In Worksheets
        If ws.Name Like "Data *" Then
            With ws
               'Assign a value to each character
                Dim AscCode As Short
                AscCode = Asc("A")

            End With

    Next ws
End Sub

1 Ответ

1 голос
/ 08 февраля 2012

Непроверенные:

Sub CopyToSummary()

Dim arrSheets, i As Integer
Dim rngId As Range, rngSummary As Range

    arrSheets = Array("A", "B", "C", "D", _
                      "E", "F", "G", "H")

    Set rngSummary = ThisWorkbook.Sheets("Summary").Range("A1")

    For i = LBound(arrSheets) To UBound(arrSheets)

        Set rngId = ThisWorkbook.Sheets("Data " & arrSheets(i)).Range("C8")
        Do While Len(rngId.Value) > 0

            With rngSummary
                .Value = rngId.Value
                .Offset(1, 0).Value = rngId.Offset(1, 0).Value
                'etc for the other values
            End With

            Set rngSummary = rngSummary.Offset(0, 1)
            Set rngId = rngId.Offset(0, 1)
        Loop

    Next i

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...