В этой статье мы создадим макрос для создания отдельных рабочих листов для каждого имени, упомянутого в данных.

Исходные данные состоят из имени, за которым следуют сведения о кампании и количество обработанных вызовов.

ArrowRawData

В этом примере мы хотим создать отдельные рабочие листы для каждого имени, и этот лист будет содержать данные, связанные с кампаниями и количеством вызовов, обработанных агентом.

ArrowOutput

Логическое объяснение

В этой статье мы создали макрос «AfterNamesCopying». Он разделит данные на разные листы в зависимости от имени агента. Чтобы разделить данные, мы проверяем наличие «имени» в данных и копируем данные под строкой «имя» на соответствующий лист.

Объяснение кода

Left (WksData.Cells (IntRow, 1), 4) = «имя»

Приведенный выше код используется для проверки того, начинается ли значение в ячейке с «имени».

Вправо (WksData.Cells (IntRow, 1), Len (WksData.Cells (IntRow, 1)) — 5)

Приведенный выше код используется для извлечения имени агента из значения ячейки.

Рабочие листы.Добавить после: = Рабочие листы (Worksheets.Count)

Приведенный выше код используется для вставки нового листа после последнего листа.

ActiveSheet.Name = StrSheet Приведенный выше код используется для переименования активного листа.

Range (.Cells (IntRowL, 1), .Cells (IntRowL, 3)). Value = _ Range (WksData.Cells (IntRow, 1), WksData.Cells (IntRow, 3)). Value Приведенный выше код используется для добавить данные, относящиеся к этому конкретному агенту.

Пожалуйста, введите код ниже

Option Explicit

Sub AfterNamesCopying()

'Declaring variables

Dim wks As Worksheet, WksData As Worksheet

Dim IntRow As Integer, IntRowL As Integer

Dim StrSheet As String

'Disabling screen updates

Application.ScreenUpdating = False

'Initializing variables

Set WksData = ActiveSheet

IntRow = 10

'Loop until cell in first column is empty

Do Until IsEmpty(WksData.Cells(IntRow, 1))



'Checking whether value in the cell begins with string "name"

If Left(WksData.Cells(IntRow, 1), 4) = "name" Then



'Extracting name from the cell value

StrSheet = Right(WksData.Cells(IntRow, 1), Len(WksData.Cells(IntRow, 1)) - 5)



'Adding new worksheet

Worksheets.Add after:=Worksheets(Worksheets.Count)



'Renaming the sheet

ActiveSheet.Name = StrSheet

IntRowL = 1



Else



With Worksheets(StrSheet)

'Inserting data to respective sheets

Range(.Cells(IntRowL, 1), .Cells(IntRowL, 3)).Value = _

Range(WksData.Cells(IntRow, 1), WksData.Cells(IntRow, 3)).Value

End With

IntRowL = IntRowL + 1

End If



IntRow = IntRow + 1

Loop

'Enabling screen updates

Application.ScreenUpdating = True

End Sub

Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.

Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]