VB требуется добавитьчасть строки вниз - Microsoft Office Excel

mike2005 · 26.11.2016, 13:29

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

PHP код:


			
oldStatusBar = Application.DisplayStatusBar

    Application.DisplayStatusBar = True

    

    'считаем строк в файле

    

    ListFrom = "lgota"

    str_list = "FIO"

    rwIndex_ListFrom = 1



    'СтолбецСравнения AW = 49

    Stolbesz_Sravnenia = 49



    'СтолбецФИО1 Е = 5

    Stolbesz_FIO1 = 5



    'СтолбецФИО2 AZ = 52

    Stolbesz_FIO2 = 52

    

    'СтолбецПоследний BR = 70

    Stolbesz_Last = 70

    Tek_poz = 0

    

    Sheets(ListFrom).Activate

    

    While str_list <> ""

        str_list = Worksheets(ListFrom).Cells(rwIndex_ListFrom, 1).Value

       ' Worksheets(ListFrom).Cells(rwIndex_ListFrom, 3).Value = Worksheets(ListFrom).Cells(rwIndex_ListFrom, 1).Value

       ' Worksheets(ListFrom).Cells(rwIndex_ListFrom, 3).Value = rwIndex_ListFrom

       

       'Проверяем схожесть фИО

            If Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO1).Value = Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2).Value Then

                Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Sravnenia).Value = 1

            Else

                '1 ФИО1 новое, те вставляем строку справа

                If Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO1).Value = Worksheets(ListFrom).Cells(rwIndex_ListFrom + 1, Stolbesz_FIO2).Value Then

                        Range(Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2), Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Last)).Insert Shift:=xlDown

                         

                         

                        ' Worksheets(ListFrom).Rows(Cells(rwIndex_ListFrom, Stolbesz_FIO2), Cells(rwIndex_ListFrom, Stolbesz_Las).Insert

                        ' Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                      

                Else

                '2 ФИО2 новое, те вставляем строку слева

                ' Range(Cells(rwIndex_ListFrom, Stolbesz_FIO1), Cells(rwIndex_ListFrom, Stolbesz_FIO1)).Select

                ' Selection.Insert Shift:=xlDown

                End If

                



            End If

        rwIndex_ListFrom = rwIndex_ListFrom + 1

    Wend

mike2005 · 26.11.2016, 14:09

те по сути не отрабатывает
ни этот вариант, ни закомментарийный

PHP код:


			
Range(Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2), Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Last)).Insert Shift:=xlDown

                         

                         

                        ' Worksheets(ListFrom).Rows(Cells(rwIndex_ListFrom, Stolbesz_FIO2), Cells(rwIndex_ListFrom, Stolbesz_Las).Insert

                        ' Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

IgorGO · 26.11.2016, 15:27

а в чем суть?
(или Вы думаете, что по коду, который не делает то, что нужно сделать, можно угадать что нужно сделать?)

mike2005 · 26.11.2016, 23:25

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

PHP код:


			
Range(Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2), Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Last)).Insert Shift:=xlDown

                         

                         

                        ' Worksheets(ListFrom).Rows(Cells(rwIndex_ListFrom, Stolbesz_FIO2), Cells(rwIndex_ListFrom, Stolbesz_Las).Insert

                        ' Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

IgorGO · 26.11.2016, 23:42

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

26.11.2016, 13:29	#1
mike2005 Новичок Джуниор Регистрация: 26.11.2016 Сообщений: 3	VB требуется добавитьчасть строки вниз помогите разобраться требуется сместить часть ячеик вниз PHP код: oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True 'считаем строк в файле ListFrom = "lgota" str_list = "FIO" rwIndex_ListFrom = 1 'СтолбецСравнения AW = 49 Stolbesz_Sravnenia = 49 'СтолбецФИО1 Е = 5 Stolbesz_FIO1 = 5 'СтолбецФИО2 AZ = 52 Stolbesz_FIO2 = 52 'СтолбецПоследний BR = 70 Stolbesz_Last = 70 Tek_poz = 0 Sheets(ListFrom).Activate While str_list <> "" str_list = Worksheets(ListFrom).Cells(rwIndex_ListFrom, 1).Value ' Worksheets(ListFrom).Cells(rwIndex_ListFrom, 3).Value = Worksheets(ListFrom).Cells(rwIndex_ListFrom, 1).Value ' Worksheets(ListFrom).Cells(rwIndex_ListFrom, 3).Value = rwIndex_ListFrom 'Проверяем схожесть фИО If Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO1).Value = Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2).Value Then Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Sravnenia).Value = 1 Else '1 ФИО1 новое, те вставляем строку справа If Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO1).Value = Worksheets(ListFrom).Cells(rwIndex_ListFrom + 1, Stolbesz_FIO2).Value Then Range(Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2), Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Last)).Insert Shift:=xlDown ' Worksheets(ListFrom).Rows(Cells(rwIndex_ListFrom, Stolbesz_FIO2), Cells(rwIndex_ListFrom, Stolbesz_Las).Insert ' Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Else '2 ФИО2 новое, те вставляем строку слева ' Range(Cells(rwIndex_ListFrom, Stolbesz_FIO1), Cells(rwIndex_ListFrom, Stolbesz_FIO1)).Select ' Selection.Insert Shift:=xlDown End If End If rwIndex_ListFrom = rwIndex_ListFrom + 1 Wend

26.11.2016, 15:27	#3
IgorGO Новичок СтарожилДжуниор Регистрация: 05.02.2008 Сообщений: 9,487	а в чем суть? (или Вы думаете, что по коду, который не делает то, что нужно сделать, можно угадать что нужно сделать?) Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

26.11.2016, 23:42	#5
IgorGO Новичок СтарожилДжуниор Регистрация: 05.02.2008 Сообщений: 9,487	без макроса, который не добавляет, а словами, что необходимо сделать? Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

Опции темы	Поиск в этой теме
Версия для печати Отправить по электронной почте	Поиск в этой теме: Расширенный поиск

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
asm: Задать три строки символов и их перемещение сверху - вниз по экрану	Aziret_@li	Помощь студентам	1	21.09.2016 11:14
макрос по удалению строк с первой строки вниз до первого числового значения в столбце "A"	Alexsandrr	Помощь студентам	11	14.10.2013 10:51
Дан двумерный массив. начиная с 1 строки сдвинуть все строки на 2 вниз, а последние 2 переместить на место первых двух строк.	Proskurina	Помощь студентам	5	03.03.2013 21:38
Авто-копирование строки вниз при заполнении текущей (или авто-отображение скрытой ниже)	bygaga	Microsoft Office Excel	6	25.11.2011 14:46
Перемещать строки вверх-вниз, с помощью стрелок.	Rio309	Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM	6	27.10.2008 21:47

26.11.2016, 14:09	#2
mike2005 Новичок Джуниор Регистрация: 26.11.2016 Сообщений: 3	те по сути не отрабатывает ни этот вариант, ни закомментарийный PHP код: Range(Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2), Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Last)).Insert Shift:=xlDown ' Worksheets(ListFrom).Rows(Cells(rwIndex_ListFrom, Stolbesz_FIO2), Cells(rwIndex_ListFrom, Stolbesz_Las).Insert ' Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

26.11.2016, 23:25	#4
mike2005 Новичок Джуниор Регистрация: 26.11.2016 Сообщений: 3	макрос не добавляет часть строки PHP код: Range(Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_FIO2), Worksheets(ListFrom).Cells(rwIndex_ListFrom, Stolbesz_Last)).Insert Shift:=xlDown ' Worksheets(ListFrom).Rows(Cells(rwIndex_ListFrom, Stolbesz_FIO2), Cells(rwIndex_ListFrom, Stolbesz_Las).Insert ' Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove