Перенос строки на другой лист

@Dahrax · Регистрация: 12.03.2018

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

Помогите пожалуйста с простой задачей, не понимаю почему не работает.

Нужно просто переносить строку из 17 столбцов в последнюю свободную строку другого листа по условию не пустой 3-й ячейки.

Так-же у меня тут не прописано, но нужно чтобы макрос удалял строку из исходного листа (2018) и сортировал оставшиеся чтобы не было пробелов. Ну или удалял строку прямо из таблицы целиком после копирования.

Вот что удалось написать мне. С VBA столкнулся впервые, пока не очень понимаю что как работает.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub sort()
Dim j As Integer
Dim var As String
 
j = 2
var = 2
 
For j = 2 To 30
If IsEmpty(Cells(j, 3)) Then GoTo 1
2:
Next j
GoTo 3
1:
Sheets("2018").Select
Range(Cells(j, 1), Cells(j, 17)).Copy
With Sheets("архив").Range("A" + var)
    .PasteSpecial (xlPasteAllExceptBorders)
End With
var = var + 1
GoTo 2
3:
End Sub

@Vlad999 · 13.03.2018, 13:53

так будет проще (как по мне).
1. Фильтр по 3 столбцу не пусто.
2. Копировать только видимые, Вставить.
3. Удалить строки с листа.
4. убрать фильтр.

@Dahrax · 13.03.2018, 14:39 **[ТС]**

У меня вопросы вот какие:
1) как удалять строки из первого листа при переносе во второй ?
2) как избавиться от моргания при копировании ?
3) как изменить макрос чтобы он каждый раз продолжал строки во второй таблице, а не заменял те что есть ?

Добавлено через 11 минут
Пока удалось сделать так. Работает. Но моргает, не удаляет строки и перезаписывает на втором листе новые архивные строки.
Как сделать ?

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
Sub archive()
 
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
Dim txt As String
Dim var As String
 
cnt = 0
txt = "*архив*"
var = 2
For i = 1 To 40
If LCase(Cells(i, 17)) Like LCase(txt) Then
cnt = cnt + 1
Sheets("2018").Select
Range(Cells(i, 1), Cells(i, 17)).Copy
With Sheets("àðõèâ").Range("A" + var)
    .PasteSpecial (xlPasteAllExceptBorders)
End With
var = var + 1
End If
 
Next i
 
 
 
MsgBox "перенесено в архив = " & cnt & " "
 
End Sub

@Vlad999 · 13.03.2018, 15:25

Сообщение от Dahrax

как избавиться от моргания при копировании ?

Visual Basic
1
2
3
Application.ScreenUpdating = False 'отключаем обновление экрана
'ваш код ....
Application.ScreenUpdating = True 'включаем обновление экрана

остальное при наличии файла примера с описанием согласно файла.

Добавлено через 5 минут

Сообщение от Dahrax

как изменить макрос чтобы он каждый раз продолжал строки во второй таблице, а не заменял те что есть ?

Visual Basic
1
2
Dim var As Long
var = Sheets("архив").Cells(Rows.Count,1).End(xlUp).Row+1

@Dahrax · 13.03.2018, 15:59 **[ТС]**

Не понимаю как нужно изменить скрипт чтобы вставить строку ...

Сейчас макрос выглядит так. Все работает кроме переноса на пустую строку а не на первую.

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
Sub archive()
 
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
Dim txt As String
Dim var As String
 
cnt = 0
txt = "*архив*"
var = 2
Application.ScreenUpdating = False
For i = 1 To 40
If LCase(Cells(i, 17)) Like LCase(txt) Then
cnt = cnt + 1
Sheets("2018").Select
Range(Cells(i, 1), Cells(i, 17)).Copy
With Sheets("архив").Range("A" + var)
    .PasteSpecial (xlPasteAllExceptBorders)
    Rows(i).Delete
End With
var = var + 1
End If
 
Next i
Application.ScreenUpdating = True
 
MsgBox "в архив перенесено = " & cnt & " "
 
End Sub

@Vlad999 · 13.03.2018, 16:06

проверяйте

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
Sub archive()
 
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
Dim txt As String
Dim var As Long
 
cnt = 0
txt = "*архив*"
var = Sheets("архив").Cells(Rows.Count,1).End(xlUp).Row + 1
Application.ScreenUpdating = False
For i = 1 To 40
   If LCase(Cells(i, 17)) Like LCase(txt) Then
        cnt = cnt + 1
        Sheets("2018").Range(Cells(i, 1), Cells(i, 17)).Copy
        Sheets("архив").Range("A" & var).PasteSpecial (xlPasteAllExceptBorders)
        Rows(i).Delete
        var = var + 1
   End If
Next i
Application.ScreenUpdating = True
 
MsgBox "в архив перенесено = " & cnt & " "
 
End Sub

@Dahrax · 13.03.2018, 16:11 **[ТС]**

Огонь ! Спасибо !

@Vlad999 · 13.03.2018, 16:27

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

Visual Basic
1
For i = 40 To 1 Step -1

@Dahrax · 13.03.2018, 16:30 **[ТС]**

Я конечно мог бы просто вставить это в код, но мне стало интересно почему ?

@Vlad999 · 13.03.2018, 16:41

например удалили строку 2 тогда 3 строка стала второй и соответственно проверка, бывшей 3 строки, уже не происходит.
А если идем снизу вверх то например 33 строку удалили 34 строка стала 33, но она уже была проверена. как то так.

для проверки у себя в примере сделайте 2 подряд строчки которые подлежат удалению. Одна после отработки макроса останется.

@Dahrax · 13.03.2018, 16:56 **[ТС]**

Все работает, ура. Спасибо еще раз.

@vikayur · 08.04.2020, 16:37

А можно файл посмотреть?

Новые блоги и статьи Все статьи Все блоги /
Unity 4D GameUnited 13.06.2025 Четырехмерное пространство. . . Звучит как что-то из научной фантастики, правда? Однако для меня, как разработчика со стажем в игровой индустрии, четвертое измерение давно перестало быть абстракцией из. . .	SSE (Server-Sent Events) в ASP.NET Core и .NET 10 UnmanagedCoder 13.06.2025 Кажется, Microsoft снова подкинула нам интересную фичу в новой версии фреймворка. Работая с превью . NET 10, я наткнулся на нативную поддержку Server-Sent Events (SSE) в ASP. NET Core Minimal APIs. Эта. . .	С днём независимости России! Hrethgir 13.06.2025 Решил побеседовать, с утра праздничного дня, с LM о завоеваниях. То что она написала о народе, представителем которого я являюсь сам сначала возмутило меня, но дальше только смешило. Это чисто. . .	Лето вокруг. kumehtar 13.06.2025 Лето вокруг. Наполненное бурями и ураганами событий. На фоне магии Жизни, священной и вечной, неумелой рукой человека рисуется панорама душевного непокоя. Странные серые краски проникают и. . .	Популярные LM модели ориентированы на увеличение затрат ресурсов пользователями сгенерированного кода (грязь -заслуги чистоплюев). Hrethgir 12.06.2025 Вообще обратил внимание, что они генерируют код (впрочем так-же ориентированы разработчики чипов даже), чтобы пользователь их использующий уходил в тот или иной убыток. Это достаточно опытные модели,. . .
Топ10 библиотек C для квантовых вычислений bytestream 12.06.2025 Квантовые вычисления - это та область, где теория встречается с практикой на границе наших знаний о физике. Пока большая часть шума вокруг квантовых компьютеров крутится вокруг языков высокого уровня. . .	Dispose и Finalize в C# stackOverflow 12.06.2025 Работая с C# больше десяти лет, я снова и снова наблюдаю одну и ту же историю: разработчики наивно полагаются на сборщик мусора, как на волшебную палочку, которая решит все проблемы с памятью. Да,. . .	Повышаем производительность игры на Unity 6 с GPU Resident Drawer GameUnited 11.06.2025 Недавно копался в новых фичах Unity 6 и наткнулся на GPU Resident Drawer - штуку, которая заставила меня присвистнуть от удивления. По сути, это внутренний механизм рендеринга, который автоматически. . .	Множества в Python py-thonny 11.06.2025 В Python существует множество структур данных, но иногда я сталкиваюсь с задачами, где ни списки, ни словари не дают оптимального решения. Часто это происходит, когда мне нужно быстро проверять. . .	Работа с ccache/sccache в рамках C++ Loafer 11.06.2025 Утилиты ccache и sccache занимаются тем, что кешируют промежуточные результаты компиляции, таким образом ускоряя последующие компиляции проекта. Это означает, что если проект будет компилироваться. . .

@Vlad999 3943 / 2336 / 790 Регистрация: 02.11.2012 Сообщений: 6,207
	13.03.2018, 13:53
	так будет проще (как по мне). 1. Фильтр по 3 столбцу не пусто. 2. Копировать только видимые, Вставить. 3. Удалить строки с листа. 4. убрать фильтр. 0

@Dahrax 0 / 0 / 0 Регистрация: 12.03.2018 Сообщений: 12
	13.03.2018, 16:11 [ТС]
	Огонь ! Спасибо ! 0

@Dahrax 0 / 0 / 0 Регистрация: 12.03.2018 Сообщений: 12
	13.03.2018, 16:30 [ТС]
	Я конечно мог бы просто вставить это в код, но мне стало интересно почему ? 0

@Vlad999 3943 / 2336 / 790 Регистрация: 02.11.2012 Сообщений: 6,207
	13.03.2018, 16:41
	например удалили строку 2 тогда 3 строка стала второй и соответственно проверка, бывшей 3 строки, уже не происходит. А если идем снизу вверх то например 33 строку удалили 34 строка стала 33, но она уже была проверена. как то так. для проверки у себя в примере сделайте 2 подряд строчки которые подлежат удалению. Одна после отработки макроса останется. 0

@Dahrax 0 / 0 / 0 Регистрация: 12.03.2018 Сообщений: 12
	13.03.2018, 16:56 [ТС]
	Все работает, ура. Спасибо еще раз. 0

@vikayur 0 / 0 / 0 Регистрация: 08.04.2020 Сообщений: 2
	08.04.2020, 16:37
	А можно файл посмотреть? 0

Перенос строки на другой лист

Решение