Копирование строчек по разным столбцам на другой лист

@tatianakkk · Регистрация: 04.09.2020

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

Здравствуйте!
мучаюсь уже несколько дней с кодом(недавно начала изучение VBA).
Нужно скопировать строчки с Лист1 на Лист2, но так, чтобы код был универсальным (чтобы можно было проделать эту процедуру с другой книгой, но с такими же строчками и столбцами).
Проблема еще заключается в том, что подпунктов 1.1.1.1 или 1.2.1.1 может быть неопределенное количество.
Прикладываю файл для примера. На лист2 уже скопировала ручками строчки и разнесла по столбцам.
Заранее спасибо!

@Hugo121 · 06.09.2020, 23:36

Здравствуйте!
Если работаете на Маке - нужно предупреждать. Там с макросами могут быть свои тараканы...

@tatianakkk · 07.09.2020, 06:55 **[ТС]**

Теперь буду знать
Но макрос будет использоваться на винде

@tatianakkk · 07.09.2020, 10:32 **[ТС]**

Здравствуйте!
мучаюсь уже несколько дней с кодом(недавно начала изучение VBA).
Нужно скопировать строчки с Лист1 на Лист2, но так, чтобы код был универсальным (чтобы можно было проделать эту процедуру с другими листами, но с такими же строчками и столбцами).
Проблема еще заключается в том, что подпунктов 1.1.1.1 или 1.1.2.1 или 1.1.2.4.1 и т.д. может быть неопределенное количество. Также могут появиться подпункты (например, 1.1.2.4.1.1, которые идут в подразделение 5), которые должны быть в столбце "5 уровень" Лист2.
Прикладываю файл для примера. На лист2 уже скопировала ручками строчки и разнесла по столбцам.
макрос должен работать на винде
Заранее спасибо!

@Hugo121 · 07.09.2020, 10:57

Я пас -
1. из примера не понял логику
2. муторно это, тупо лень даже если и пойму

@КостяФедореев · 07.09.2020, 13:38

tatianakkk,
так подойдет?

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
Sub www()
Application.ScreenUpdating = True
Sheets("Лист1").Range("B5:C59").Copy
Sheets("Лист1").Range("F3").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
 
    For i = 6 To 1000
    Sheets("Лист2").Activate
    last = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
    rr = Sheets("Лист1").Cells(3, i)
    nextP = Len(Trim(Mid(rr, 4, Len(rr))))
    
        If InStr(1, rr, "Орг") Then
                If nextP = "1" Then
                    n = 1
                End If
                If nextP = "3" Then
                    n = 2
                End If
                If nextP = "5" Then
                    n = 3
                End If
                If nextP = "7" Then
                    n = 4
                End If
            
            Sheets("Лист2").Cells(last, n) = Sheets("Лист1").Cells(3, i)
            Sheets("Лист2").Cells(last, 7) = Sheets("Лист1").Cells(4, i)
            n = n + 1
        
        Else
        
            Sheets("Лист2").Cells(last, n) = Sheets("Лист1").Cells(3, i)
            Sheets("Лист2").Cells(last, 7) = Sheets("Лист1").Cells(4, i)
            
        End If
    
    Next
 
Sheets("Лист1").Range("F3:AAA4").Cells.Clear
Application.ScreenUpdating = False
End Sub

@tatianakkk · 07.09.2020, 20:11 **[ТС]**

спасибо!

Добавлено через 51 минуту
nextP = Len(Trim(Mid(rr, 4, Len(rr))))

считает количество знаков в ячейке?

@КостяФедореев · 07.09.2020, 20:15

tatianakkk,
не совсем, там количество символов от функции Mid
почитайте строковые функции VBA, будет понятней

@Hugo121 · 07.09.2020, 20:17

Кстати тут

Visual Basic
1
, Len(rr)

лишнее.

@КостяФедореев · 07.09.2020, 21:44

tatianakkk,
подправил, с дополнением из соседней темы "Растягивание ячейки в пустых строчках до какого-либо текста"

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
Sub www()
Application.ScreenUpdating = True
    For i = 5 To Sheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row
    Sheets("Лист2").Activate
    last = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
    rr = Sheets("Лист1").Cells(i, 2)
    nextP = Len(Trim(Mid(rr, 4)))
        If InStr(1, rr, "Орг") Then
                If nextP = "1" Then
                    n = 1
                End If
                If nextP = "3" Then
                    n = 2
                End If
                If nextP = "5" Then
                    n = 3
                End If
                If nextP = "7" Then
                    n = 4
                End If
            Sheets("Лист2").Cells(last, n) = Sheets("Лист1").Cells(i, 2)
            Sheets("Лист2").Cells(last, 7) = Sheets("Лист1").Cells(i, 3)
            n = n + 1
        Else
            Sheets("Лист2").Cells(last, n) = Sheets("Лист1").Cells(i, 2)
            Sheets("Лист2").Cells(last, 7) = Sheets("Лист1").Cells(i, 3)
        End If
    Next i
    For n = 1 To 6
        For i = 5 To last
            If Sheets("Лист2").Cells(i, n).Value = "" Then
                Sheets("Лист2").Cells(i, n) = Sheets("Лист2").Cells(i - 1, n)
            End If
        Next i
    Next n
 
Application.ScreenUpdating = False
End Sub

@tatianakkk · 07.09.2020, 22:11 **[ТС]**

ругается на For i = 5 To last
заменила last на Sheets("Лист2").Cells(Rows.Count, 8).End(xlUp).row
и все заработало
Спасибо большое!

Новые блоги и статьи Все статьи Все блоги /
Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .	Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .
Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .	Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .	Отправка уведомления на почту при создании или изменении элементов справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи электронной. . .

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	06.09.2020, 23:36
	Здравствуйте! Если работаете на Маке - нужно предупреждать. Там с макросами могут быть свои тараканы... 0

@tatianakkk 0 / 0 / 0 Регистрация: 04.09.2020 Сообщений: 13
	07.09.2020, 06:55 [ТС]
	Теперь буду знать Но макрос будет использоваться на винде 0

@Hugo121 6998 / 2896 / 555 Регистрация: 19.10.2012 Сообщений: 8,804
	07.09.2020, 10:57
	Я пас - 1. из примера не понял логику 2. муторно это, тупо лень даже если и пойму 0

@tatianakkk 0 / 0 / 0 Регистрация: 04.09.2020 Сообщений: 13
	07.09.2020, 20:11 [ТС]
	спасибо! Добавлено через 51 минуту nextP = Len(Trim(Mid(rr, 4, Len(rr)))) считает количество знаков в ячейке? 0

@КостяФедореев Часто онлайн 987 / 637 / 280 Регистрация: 09.01.2017 Сообщений: 2,080
	07.09.2020, 20:15
	tatianakkk, не совсем, там количество символов от функции Mid почитайте строковые функции VBA, будет понятней 0

@tatianakkk 0 / 0 / 0 Регистрация: 04.09.2020 Сообщений: 13
	07.09.2020, 22:11 [ТС]
	ругается на For i = 5 To last заменила last на Sheets("Лист2").Cells(Rows.Count, 8).End(xlUp).row и все заработало Спасибо большое! 0