Перевести программу с псевдокода

@lalike · Регистрация: 24.01.2011

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

не подскажете, как прописать:
начало
переменные
Х 'порядковый номер от 2 до бесконечности
Х=2
Начало цикла
Для Х+1
Если Столбец 4 Строка Х не равен 0,
то удалить строку
Конец цикла
конец прграммы

Большое спасибо!

@Busine2009 · 28.01.2011, 09:25

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

Если Столбец 4 Строка Х

сначала всегда указывается строка, а потом столбец (исключение Excel, когда адреса ячеек имеют вид A1).

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

Visual Basic
1
2
3
4
5
6
7
8
Sub m_1()
Dim x As Long
For x = 1 To 10
    If Cells(x, 1) <> 0 Then
        Cells(x, 1).EntireRow.Delete
    End If
Next x
End Sub

@lalike · 28.01.2011, 09:29 **[ТС]**

а как это написать можно?

Visual Basic
1
2
3
4
5
6
7
8
9
Sub s()
Dim X, i as long
x = 2
For x = x + 1 
if stroka X stolbec 4 <> 0
delete stroka X
end if
next x
End Sub

Добавлено через 47 секунд
спаибо
вариант выше это как я с помощью книжки это делал))))

Добавлено через 14 секунд
почти сошлось))

@Busine2009 · 28.01.2011, 09:32

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

Visual Basic
1
Dim X As Long, i As Long

@lalike · 28.01.2011, 09:35 **[ТС]**

Странно, почему то несколько раз приходится проводить макрос
за раз он только несколько строк удаляет

Visual Basic
1
2
3
4
5
6
7
8
Sub m_1()
Dim x As Long
For x = 2 To 450 'не беря в расчет шапку. 450 строк всего в таблице
    If Cells(x, 4) <> 0 Then '4ый столбец
        Cells(x, 4).EntireRow.Delete
    End If
Next x
End Sub

@Busine2009 · 28.01.2011, 09:43

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

Странно, почему то несколько раз приходится проводить макрос
за раз он только несколько строк удаляет

так и должно быть: удалять нужно снизу вверх.

@lalike · 28.01.2011, 09:44 **[ТС]**

а как это сделать?

Добавлено через 21 секунду
и как сохранять макрос в персональной книге макросов?

@Busine2009 · 28.01.2011, 09:56

lalike,
введите в поле Справки "for next" и нажмите Enter. Посмотрите пример, где есть Step -1.

@lalike · 31.01.2011, 14:06 **[ТС]**

а как можно написать следующее:

1 начало цикла
2 найти объединенные ячейки
3 применить макрос Remerged

makros_remerged

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
Sub ReMerge()   ' перегруппировать сгруппированную ячейку или сгруппировать ячейки выделенного диапазона с заполнением скрытых ячеек формулами-ссылками на первую ячейку 
    If TypeName(Selection) <> "Range" Then Exit Sub 
    If Selection.Cells.Count <= 1 Then Exit Sub 
    Dim i%, iCell As Range, ActRng As Range 
    Dim ActSh As Worksheet, TempSh As Worksheet 
    Dim lLastRow&: lLastRow = Cells.SpecialCells(xlLastCell).Row 
    Dim lLastCol&: lLastCol = Selection.Column + Selection.Columns.Count - 1 
    If lLastRow > Selection.Row + Selection.Rows.Count - 1 Then lLastRow = Selection.Row + Selection.Rows.Count - 1 
    Set ActRng = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), Cells(lLastRow, lLastCol))) 
    Application.ScreenUpdating = False: Application.DisplayAlerts = False 
 
    Set ActSh = ActiveSheet: Set TempSh = Sheets.Add   ' запомнить текущую и создать новую страницу 
    ActRng.Copy TempSh.Range(ActRng.Address) 
    ActSh.Activate 
    Selection.UnMerge 
    For i = 2 To ActRng.Cells.Count   ' заполнить Selection формулами-ссылками на первую ячейку 
       ActRng(i).Formula = "=" & ActRng(1).Address 
       ActRng(i).Replace What:="$", Replacement:="", LookAt:=xlPart  ' сделать ссылки перемещаемыми 
    Next 
    TempSh.Range(ActRng.Address).Merge 
    TempSh.Range(ActRng.Address).Copy: ActRng.PasteSpecial xlPasteFormats: TempSh.Delete 
    Set ActSh = Nothing: Set TempSh = Nothing: Set ActRng = Nothing 
    Application.ScreenUpdating = True: Application.DisplayAlerts = True 
End Sub

макрос выше выполняет "правильное" объединение ячеек. в этом случае фильтры показывают правильную информацию.

проблема в том, что таких ячеек около 20 000. Помогите, пожалуйста?)

Добавлено через 10 минут
Вот такой простенький код найдет объединенные ячейки на листе

Visual Basic
1
2
3
4
Sub MCells()
   Application.FindFormat.MergeCells = True
    Cells.Find(What:="", After:=ActiveCell, MatchCase:=False, SearchFormat:=True).Activate
End Sub

как ба теперь объединить эти два макроса в один?

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

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
Sub m_1()
Dim i As Long
For i = 1 To 10000 ' количество ячеек в моей таблице
 
 
Application.FindFormat.MergeCells = True
Cells.Find(What:="", After:=ActiveCell, MatchCase:=False, SearchFormat:=True).Activate
 
 
If TypeName(Selection) <> "Range" Then Exit Sub
If Selection.Cells.Count <= 1 Then Exit Sub
Dim i%, iCell As Range, ActRng As Range
Dim ActSh As Worksheet, TempSh As Worksheet
Dim lLastRow&: lLastRow = Cells.SpecialCells(xlLastCell).Row
Dim lLastCol&: lLastCol = Selection.Column + Selection.Columns.Count - 1
If lLastRow > Selection.Row + Selection.Rows.Count - 1 Then lLastRow = Selection.Row + Selection.Rows.Count - 1
Set ActRng = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), Cells(lLastRow, lLastCol)))
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Set ActSh = ActiveSheet: Set TempSh = Sheets.Add ' запомнить текущую и создать новую страницу
ActRng.Copy TempSh.Range(ActRng.Address)
ActSh.Activate
Selection.UnMerge
For i = 2 To ActRng.Cells.Count ' заполнить Selection формулами-ссылками на первую ячейку
ActRng(i).Formula = "=" & ActRng(1).Address
ActRng(i).Replace What:="$", Replacement:="", LookAt:=xlPart ' сделать ссылки перемещаемыми
Next
TempSh.Range(ActRng.Address).Merge
TempSh.Range(ActRng.Address).Copy: ActRng.PasteSpecial xlPasteFormats: TempSh.Delete
Set ActSh = Nothing: Set TempSh = Nothing: Set ActRng = Nothing
Application.ScreenUpdating = True: Application.DisplayAlerts = True
 
Next i
End Sub

может так??

@Busine2009 · 31.01.2011, 14:41

Что это означает?

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

IF TypeName(Selection) <> "Range" THEN EXIT SUB

В каком случае будет не Range?

@lalike · 31.01.2011, 14:54 **[ТС]**

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
Sub cikl()
Dim x As Long
Dim i%, iCell As Range, ActRng As Range
Dim ActSh As Worksheet, TempSh As Worksheet
Dim lLastRow&: lLastRow = Cells.SpecialCells(xlLastCell).Row
Dim lLastCol&: lLastCol = Selection.Column + Selection.Columns.Count - 1
 
For x = 1 To 100
Application.FindFormat.MergeCells = True
Cells.Find(What:="", After:=ActiveCell, MatchCase:=False, SearchFormat:=True).Activate
If TypeName(Selection) <> "Range" Then Exit Sub
If Selection.Cells.Count <= 1 Then Exit Sub
 
If lLastRow > Selection.Row + Selection.Rows.Count - 1 Then lLastRow = Selection.Row + Selection.Rows.Count - 1
Set ActRng = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), Cells(lLastRow, lLastCol)))
Application.ScreenUpdating = False: Application.DisplayAlerts = False
 
Set ActSh = ActiveSheet: Set TempSh = Sheets.Add ' ????????? ??????? ? ??????? ????? ????????
ActRng.Copy TempSh.Range(ActRng.Address)
ActSh.Activate
Selection.UnMerge
For i = 2 To ActRng.Cells.Count ' ????????? Selection ?????????-???????? ?? ?????? ??????
ActRng(i).Formula = "=" & ActRng(1).Address
ActRng(i).Replace What:="$", Replacement:="", LookAt:=xlPart ' ??????? ?????? ?????????????
Next
TempSh.Range(ActRng.Address).Merge
TempSh.Range(ActRng.Address).Copy: ActRng.PasteSpecial xlPasteFormats: TempSh.Delete
Set ActSh = Nothing: Set TempSh = Nothing: Set ActRng = Nothing
Application.ScreenUpdating = True: Application.DisplayAlerts = True
Next x
End Sub

у ьеня так через раз работает((

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

Добавлено через 28 секунд
Busine2009, Я не знаю, что такое Range

@Busine2009 · 31.01.2011, 14:56

lalike,
Excel какой модели у вас?

@lalike · 31.01.2011, 14:56 **[ТС]**

Busine2009, взято отсюда

[форум]

Добавлено через 19 секунд
Busine2009, Excel 2007)

@Busine2009 · 31.01.2011, 15:00

lalike,
Help - Microsoft Visual Basic for Application Help - Excel Object Model Reference - Range Object - Methods - Find Method.
Смотрите пример. Если не понятно, то спрашивайте.

@lalike · 31.01.2011, 15:07 **[ТС]**

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

когда два этих макроса поочередности выполняю, все работает так, как мне надо,
но когда выполняю цикл, почему то он объединяет ячейки не так.

@Busine2009 · 31.01.2011, 15:10

lalike,
а что вообще нужно; в чём смысл?

@lalike · 31.01.2011, 15:21 **[ТС]**

с объединенными ячейками фильтры не работают корректно. т.е. показываю только одну заполненную ячейку, игнорируя все остальные.

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

я вобщем то решил эту проблему, но не совсем красиво.

Visual Basic
1
2
3
4
5
6
7
8
9
Sub Циклик()
   Dim x As Long
   For x = 1 To 100 'в этом моменте не состыковки, я не знаю, сколько раз делать. Мне нужно до конца таблицы, поэтому я ставль число - количество ячеек в таблице.
 
    Application.Run "'01.xls'!Лист1.MCells"
    Application.Run "'01.xls'!Лист1.ReMerge"
   Next x
   
End Sub

а это MCells и ReMerge

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
Sub ReMerge()   ' ???????????????? ??????????????? ?????? ??? ????????????? ?????? ??????????? ????????? ? ??????????? ??????? ????? ?????????-???????? ?? ?????? ??????
    If TypeName(Selection) <> "Range" Then Exit Sub
    If Selection.Cells.Count <= 1 Then Exit Sub
    Dim i%, iCell As Range, ActRng As Range
    Dim ActSh As Worksheet, TempSh As Worksheet
    Dim lLastRow&: lLastRow = Cells.SpecialCells(xlLastCell).Row
    Dim lLastCol&: lLastCol = Selection.Column + Selection.Columns.Count - 1
    If lLastRow > Selection.Row + Selection.Rows.Count - 1 Then lLastRow = Selection.Row + Selection.Rows.Count - 1
    Set ActRng = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), Cells(lLastRow, lLastCol)))
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
 
    Set ActSh = ActiveSheet: Set TempSh = Sheets.Add   ' ????????? ??????? ? ??????? ????? ????????
    ActRng.Copy TempSh.Range(ActRng.Address)
    ActSh.Activate
    Selection.UnMerge
    For i = 2 To ActRng.Cells.Count   ' ????????? Selection ?????????-???????? ?? ?????? ??????
       ActRng(i).Formula = "=" & ActRng(1).Address
       ActRng(i).Replace What:="$", Replacement:="", LookAt:=xlPart  ' ??????? ?????? ?????????????
    Next
    TempSh.Range(ActRng.Address).Merge
    TempSh.Range(ActRng.Address).Copy: ActRng.PasteSpecial xlPasteFormats: TempSh.Delete
    Set ActSh = Nothing: Set TempSh = Nothing: Set ActRng = Nothing
    Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub
Sub MCells()
Application.FindFormat.MergeCells = True
Cells.Find(What:="", After:=ActiveCell, MatchCase:=False, SearchFormat:=True).Activate
End Sub

@Busine2009 · 31.01.2011, 15:29

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

снова объединять.

а зачем снова объединять?

Добавлено через 2 минуты
Т.е. нужно разъединить объединённые ячейки, провести фильтрацию, а затем вернуть так, как было?

@lalike · 31.01.2011, 15:51 **[ТС]**

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

Т.е. нужно разъединить объединённые ячейки, провести фильтрацию, а затем вернуть так, как было?

впринципе, да. это очень удобно для фильтрации. прочто с объединенными ячейкамиочень сложно работать.

поэтому он их преобразует (макрос) в 4 (допустим) вписывает в остальные три ту же информацию и снова объединяет, скрывая 3.

итак мы имеем очень наглядную таблицу и правильно отформатированную одновременно

@Busine2009 · 31.01.2011, 15:53

lalike,
а фильтрация когда проходит, если всё за один проход макроса совершается?

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29

	Перевести программу с псевдокода 28.01.2011, 08:50. Показов 5769. Ответов 22 Метки нет (Все метки) не подскажете, как прописать: начало переменные Х 'порядковый номер от 2 до бесконечности Х=2 Начало цикла Для Х+1 Если Столбец 4 Строка Х не равен 0, то удалить строку Конец цикла конец прграммы Большое спасибо! 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	28.01.2011, 09:44 [ТС]
	а как это сделать? Добавлено через 21 секунду и как сохранять макрос в персональной книге макросов? 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	28.01.2011, 09:56
	lalike, введите в поле Справки "for next" и нажмите Enter. Посмотрите пример, где есть Step -1. 1

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	31.01.2011, 14:56
	lalike, Excel какой модели у вас? 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	31.01.2011, 14:56 [ТС]
	Busine2009, взято отсюда [форум] Добавлено через 19 секунд Busine2009, Excel 2007) 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	31.01.2011, 15:00
	lalike, Help - Microsoft Visual Basic for Application Help - Excel Object Model Reference - Range Object - Methods - Find Method. Смотрите пример. Если не понятно, то спрашивайте. 0

@lalike 0 / 0 / 0 Регистрация: 24.01.2011 Сообщений: 29
	31.01.2011, 15:07 [ТС]
	вроде бы все понятно и соединил я макросы, но теперь не делает то, что надо. когда два этих макроса поочередности выполняю, все работает так, как мне надо, но когда выполняю цикл, почему то он объединяет ячейки не так. 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	31.01.2011, 15:10
	lalike, а что вообще нужно; в чём смысл? 0

@Busine2009 2309 / 1541 / 115 Регистрация: 13.06.2009 Сообщений: 5,575
	31.01.2011, 15:53
	lalike, а фильтрация когда проходит, если всё за один проход макроса совершается? 0

Перевести программу с псевдокода

Решение