Автоматизировать процесс копирования большого количества данных из исходной таблицы в другую

@temafey · Регистрация: 20.02.2012

Студворк — интернет-сервис помощи студентам

Здравствуйте Уважаемые Форумчане!

Обращаюсь к Вас с такой просьбой:

Выше уже обсуждалось что-то похожее.

Хотелось автоматизтровать процесс копирования большого количества данных из исходной таблицы в таблицу с изменненными немного местами ячеек, строк и столбцов. Для примера прикладываю таблицу, где где наглядно изображено что мне необходимо. На первой странице изображена исходная таблица с данными, а на второй, таблица с данными которая должна получиться. Ячейки с данными я пометил буквами. Прошу заметить что, количество шагов может меняться - где 5, где 2, где 3 и тд
Я уверен что для знатоков скриптования и макросописания для Excel это пара пустяков, а для меня это целая наука, которую надо изучать с нуля и потратить на это кучу времени, поэтому поймите правильно.

Заранее благодарю Вас.

@mc-black · 20.02.2012, 15:33

Прикрепляю файл с решением. Инфа переносится с первого листа на третий. Запуск макроса - кнопкой на третьем листе. На всякий случай код модуля:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Option Explicit
 
Sub test_cases()
    Dim src As Worksheet, dst As Worksheet
    Dim i As Long, k As Long, m As Long
    
    Set src = ThisWorkbook.Worksheets("Sheet1")
    Set dst = ThisWorkbook.Worksheets("Sheet3")
    
    ' Определить конечную строку первой таблицы
    For m = src.UsedRange.Row + src.UsedRange.Rows.Count - 1 To 1 Step -1
        If src.Rows(m).Text = "" Then Else Exit For
    Next
    
    i = 2 ' Начало первой таблицы
    k = 2 ' Начало второй таблицы
    Do While i <= m
        If src.Cells(i, 1).Value <> Empty Then
            dst.Cells(k, 1).Value = src.Cells(i, 1).Value
            dst.Cells(k, 2).Value = src.Cells(i, 2).Value
            dst.Cells(k, 4).Value = src.Cells(i, 6).Value
            If src.Cells(i + 1, 9).Value <> Empty Then k = k - 1
        ElseIf src.Cells(i, 9).Value <> Empty Then
            dst.Cells(k, 6).Value = src.Cells(i, 9).Value
            dst.Cells(k, 7).Value = src.Cells(i, 10).Value
        End If
        k = k + 1
        i = i + 1
    Loop
    
    Set src = Nothing
    Set dst = Nothing
End Sub

@temafey · 20.02.2012, 17:11 **[ТС]**

mc-black, Спасибо огромнейшее доброй души человек!!!!

@temafey · 21.02.2012, 00:23 **[ТС]**

mc-black,

еще раз требуется твоя помощь. выяснилось что конечная таблица, а точнее шаги в ней должны располагаться немного иначе - в одну строку и шаги должны быть пронумерованы - step1, step2 и тд. я отобразил это в приложенном файле. Спасибо большущее заранее.

@mc-black · 21.02.2012, 17:55

Код получился страшненький, но рабочий:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Option Explicit
 
Sub tables()
    Dim src As Worksheet, dst As Worksheet
    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    
    Set src = ThisWorkbook.Worksheets("Sheet1")
    Set dst = ThisWorkbook.Worksheets("Sheet3")
    
    ' Определить конечную строку первой таблицы
    For m = src.UsedRange.Row + src.UsedRange.Rows.Count - 1 To 1 Step -1
        If src.Rows(m).Text = "" Then Else Exit For
    Next
    
    i = 2 ' Начало первой таблицы
    k = 2 ' Начало второй таблицы
    n = 2 ' Начало для форматирования
    Do While i <= m
        If src.Cells(i, 1).Value <> Empty Then
            dst.Cells(k, 1).Value = src.Cells(i, 1).Value
            dst.Cells(k, 2).Value = src.Cells(i, 2).Value
            dst.Cells(k, 4).Value = src.Cells(i, 6).Value
            If src.Cells(i + 1, 9).Value <> Empty Then
                k = k - 1
                j = 1
            End If
        ElseIf src.Cells(i, 9).Value <> Empty Then
            dst.Cells(k, 5).Value = "step" & j
            j = j + 1
            dst.Cells(k, 6).Value = src.Cells(i, 9).Value
            dst.Cells(k, 7).Value = src.Cells(i, 10).Value
        End If
        If src.Cells(i + 1, 1).Value <> Empty Or (i = m) Then
            With dst.Range(dst.Cells(n, 1), dst.Cells(k, 1))
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            With dst.Range(dst.Cells(n, 2), dst.Cells(k, 2))
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            With dst.Range(dst.Cells(n, 3), dst.Cells(k, 3))
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            With dst.Range(dst.Cells(n, 4), dst.Cells(k, 4))
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            dst.Range(dst.Cells(n, 1), dst.Cells(k, 4)).Interior.ColorIndex = 40
            With dst.Range(dst.Cells(n, 5), dst.Cells(k, 7))
                .Interior.ColorIndex = 36
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideHorizontal).Weight = xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            n = k + 1
        End If
        k = k + 1
        i = i + 1
    Loop
    
    Set src = Nothing
    Set dst = Nothing
End Sub

Пример файла с макросом, переносящий на таблицу 3 прикладываю.

@temafey · 23.02.2012, 10:58 **[ТС]**

mc-black, спасибо тебе огромнейшее за то что, ты делаешь.

Все прекрасно работает, только одно но. Можно сделать, чтобы ячейки в стобцах Subject, Test Name, Test Type были цельными(Merged), тк потом с помощью одного макроса, эту таблицу надо будет аплоадить в нашу системую, я боюсь чтобы не возникло проблем с распознаванием ячеей этим макросом и тд. Еще хотел тебя попросить чтобы код добавлял три столбца "Application", "Module", "Command" перед основной таблицой и два за ней "Test Data (Design Steps)" и Designer, и в поле Test type добавлял "Test Case", а в поле Command добавлял "HUB". как это
это должно выглядеть, я отобразил в приложенном файле.

Спасибо!

@mc-black · 25.02.2012, 17:16

В продолжение:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Option Explicit
 
Sub table1()
    Dim src As Worksheet, dst As Worksheet
    Dim i As Long, j As Long, k As Long, m As Long, n As Long, l As Long
    
    Set src = ThisWorkbook.Worksheets("Sheet1")
    Set dst = ThisWorkbook.Worksheets("Sheet3")
    
    ' Определить конечную строку первой таблицы
    For m = src.UsedRange.Row + src.UsedRange.Rows.Count - 1 To 1 Step -1
        If src.Rows(m).Text = "" Then Else Exit For
    Next
    
    i = 2 ' Начало первой таблицы
    k = 2 ' Начало второй таблицы
    n = 2 ' Начало для форматирования
    Do While i <= m
        ' Если переносятся данные левых столбцов
        If src.Cells(i, 1).Value <> Empty Then
            dst.Cells(k, 3).Value = "HUB"
            dst.Cells(k, 4).Value = src.Cells(i, 1).Value
            dst.Cells(k, 5).Value = src.Cells(i, 2).Value
            dst.Cells(k, 6).Value = "Test Case"
            dst.Cells(k, 7).Value = src.Cells(i, 6).Value
            If src.Cells(i + 1, 9).Value <> Empty Then
                k = k - 1
                j = 1
            End If
        ' Если переносятся данные правых столбцов
        ElseIf src.Cells(i, 9).Value <> Empty Then
            'dst.Cells(k, 5).Value = "step " & j
            'j = j + 1
            dst.Cells(k, 8).Value = src.Cells(i, 9).Value
            dst.Cells(k, 9).Value = src.Cells(i, 9).Value
            dst.Cells(k, 10).Value = src.Cells(i, 10).Value
        End If
        ' Форматирование по завершению переноса текста блока
        If src.Cells(i + 1, 1).Value <> Empty Or (i = m) Then
            ' Объединение ячеек и форматирование их
            For l = 1 To 7
                With dst.Range(dst.Cells(n, l), dst.Cells(k, l))
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Borders(xlEdgeTop).Weight = xlThin
                    .Borders(xlEdgeBottom).Weight = xlThin
                    .Borders(xlEdgeLeft).Weight = xlThin
                    .Borders(xlEdgeRight).Weight = xlThin
                End With
            Next
            ' Окрашивание диапазона в телесный цвет
            dst.Range(dst.Cells(n, 4), dst.Cells(k, 7)).Interior.ColorIndex = 40
            ' Форматирование правой части таблицы
            With dst.Range(dst.Cells(n, 8), dst.Cells(k, 12))
                .Interior.ColorIndex = 36
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideHorizontal).Weight = xlThin
                .Borders(xlInsideVertical).Weight = xlThin
            End With
            n = k + 1
        End If
        k = k + 1
        i = i + 1
    Loop
    
    Set src = Nothing
    Set dst = Nothing
End Sub

@temafey · 28.02.2012, 11:29 **[ТС]**

mc-black, спасибо все работает как надо, за исключение одной вещи: в столбец "Step Name (Design Steps)" вместо названия шагов step1, step2, step3... копируются данные со столбца "Description (Design Steps)" Спасибо!

@mc-black · 28.02.2012, 14:50

Исправил всего 1 символ в коде - верно берет номера этапов.

@temafey · 01.03.2012, 23:28 **[ТС]**

mc-black, спасибо тебе огромнейшее. в знак благодарности могу помочь с билетами на евро 2012, с жильем в Варшаве и тд, если конечно собираешься=) если что пиши в асю(272507465) Еще раз спасибо!

14.03.2013, 19:05

Сообщение от mc-black

Исправил всего 1 символ в коде - верно берет номера этапов.

Уважаемый mc-black, не могли бы вы мне помочь с экселем?
мне нужно следующее:
с первого листа нужно упорядоченно скопировать/перенести данные на второй лист в соответствующие ячейки.
На втором листе первая строчка эта пример расположения данных.

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»	SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .

@temafey 0 / 0 / 0 Регистрация: 20.02.2012 Сообщений: 6
	20.02.2012, 17:11 [ТС]
	mc-black, Спасибо огромнейшее доброй души человек!!!! 0

@temafey 0 / 0 / 0 Регистрация: 20.02.2012 Сообщений: 6
	28.02.2012, 11:29 [ТС]
	mc-black, спасибо все работает как надо, за исключение одной вещи: в столбец "Step Name (Design Steps)" вместо названия шагов step1, step2, step3... копируются данные со столбца "Description (Design Steps)" Спасибо! 0

@temafey 0 / 0 / 0 Регистрация: 20.02.2012 Сообщений: 6
	01.03.2012, 23:28 [ТС]
	mc-black, спасибо тебе огромнейшее. в знак благодарности могу помочь с билетами на евро 2012, с жильем в Варшаве и тд, если конечно собираешься=) если что пиши в асю(272507465) Еще раз спасибо! 0