Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как правильно организовать циклы? - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Как правильно организовать циклы?
alexban65 Дата: Вторник, 09.04.2019, 07:50 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Есть 3 вложенных цикла, типа For n=1 To X ..... Next n.
Они запускаются по нажатию кнопки на Лист 1.
1 цикл - перебор ячеек, по столбцам, в определенной строке, Лист 1
2 цикл, вложенный - перебор ячеек, по столбцам, в определенной строке, Лист 2
3 цикл, вложенный - Если ячейки в Лист 1 и Лист 2 совпали - в Лист 1, в совпавшей колонке, ниже, ячейка заполняется данными из Лист 2.
Сделал как мог, но коряво...
[vba]
Код

With Sheets("Sheet1"): iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With 'EndCell, лист для заполнения
With Sheets("Sheet1"): iEndCol = .UsedRange.Columns.Count: End With 'Последний столбец
With Sheets("ПК"): lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With  'EndCell,источник лист для копирования
With Sheets("ПК"): lEndCol = .UsedRange.Columns.Count: End With 'Последний столбец

MsgBox iEndCol & " - " & iLastRow
MsgBox lEndCol & " - " & lLastRow

For j = 2 To iEndCol ' По столбцам лист1
    For i = 2 To lEndCol ' По столбцам лист2
        For n = iLastRow + 1 To lLastRow '+ iLastRow ' c последней пустой, цикл по ячейкам
            If StrComp(Sheets("Sheet1").Cells(iLastRow, j), Sheets("ПК").Cells(1, i), vbTextCompare) = 0 Then 'если ячейки в колонке совпали
                        Sheets("Sheet1").Cells(n, j).Value = Sheets("ПК").Cells(n, j) ' копируем ячейки построчно, поколоночно, в той колонке что совпала
                        'Sheets("Sheet1").Cells(n, 1).Value = Sheets("ПК").Cells(n, 1) ' ставим Unique_Id в 1 столбец
                        'MsgBox j & "=" & i & "=" & " = " & n
            Else
                Exit For ' совпадения нет-выходим из цикла
            End If
        Next n
    Next i
Next j
[/vba]
Если количество проверяемых столбцов не совпадает - данные "плывут" по столбцам и строкам.

Как правильно организовать циклы - что бы несовпадающие столбцы(в первых двух циклах) не влияли на вставку данных в Лист 1?
Может, нужен другой подход?
К сообщению приложен файл: InventWork.xlsm (40.3 Kb)


Сообщение отредактировал alexban65 - Вторник, 09.04.2019, 07:58
 
Ответить
СообщениеЕсть 3 вложенных цикла, типа For n=1 To X ..... Next n.
Они запускаются по нажатию кнопки на Лист 1.
1 цикл - перебор ячеек, по столбцам, в определенной строке, Лист 1
2 цикл, вложенный - перебор ячеек, по столбцам, в определенной строке, Лист 2
3 цикл, вложенный - Если ячейки в Лист 1 и Лист 2 совпали - в Лист 1, в совпавшей колонке, ниже, ячейка заполняется данными из Лист 2.
Сделал как мог, но коряво...
[vba]
Код

With Sheets("Sheet1"): iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With 'EndCell, лист для заполнения
With Sheets("Sheet1"): iEndCol = .UsedRange.Columns.Count: End With 'Последний столбец
With Sheets("ПК"): lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With  'EndCell,источник лист для копирования
With Sheets("ПК"): lEndCol = .UsedRange.Columns.Count: End With 'Последний столбец

MsgBox iEndCol & " - " & iLastRow
MsgBox lEndCol & " - " & lLastRow

For j = 2 To iEndCol ' По столбцам лист1
    For i = 2 To lEndCol ' По столбцам лист2
        For n = iLastRow + 1 To lLastRow '+ iLastRow ' c последней пустой, цикл по ячейкам
            If StrComp(Sheets("Sheet1").Cells(iLastRow, j), Sheets("ПК").Cells(1, i), vbTextCompare) = 0 Then 'если ячейки в колонке совпали
                        Sheets("Sheet1").Cells(n, j).Value = Sheets("ПК").Cells(n, j) ' копируем ячейки построчно, поколоночно, в той колонке что совпала
                        'Sheets("Sheet1").Cells(n, 1).Value = Sheets("ПК").Cells(n, 1) ' ставим Unique_Id в 1 столбец
                        'MsgBox j & "=" & i & "=" & " = " & n
            Else
                Exit For ' совпадения нет-выходим из цикла
            End If
        Next n
    Next i
Next j
[/vba]
Если количество проверяемых столбцов не совпадает - данные "плывут" по столбцам и строкам.

Как правильно организовать циклы - что бы несовпадающие столбцы(в первых двух циклах) не влияли на вставку данных в Лист 1?
Может, нужен другой подход?

Автор - alexban65
Дата добавления - 09.04.2019 в 07:50
skais Дата: Вторник, 09.04.2019, 11:16 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 236
Репутация: 29 ±
Замечаний: 20% ±

Excel 2010
3 цикл, вложенный - Если ячейки в Лист 1 и Лист 2 совпали - в Лист 1, в совпавшей колонке, ниже, ячейка заполняется данными из Лист 2.

Попытайтесь объяснить логику этого выражения. Ну и с циклами у Вас здесь конечно все перемешанно.
Цитата
For n = iLastRow + 1 To lLastRow

LastRow с разных листов - где логика?
Лучше опишите заново простой пример как есть и как нужно с наглядным примером.


Сообщение отредактировал skais - Вторник, 09.04.2019, 11:17
 
Ответить
Сообщение
3 цикл, вложенный - Если ячейки в Лист 1 и Лист 2 совпали - в Лист 1, в совпавшей колонке, ниже, ячейка заполняется данными из Лист 2.

Попытайтесь объяснить логику этого выражения. Ну и с циклами у Вас здесь конечно все перемешанно.
Цитата
For n = iLastRow + 1 To lLastRow

LastRow с разных листов - где логика?
Лучше опишите заново простой пример как есть и как нужно с наглядным примером.

Автор - skais
Дата добавления - 09.04.2019 в 11:16
alexban65 Дата: Вторник, 09.04.2019, 12:35 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Логика такова:

Активный лист - Лист 1.
В Лист 1, в строке=2, в ячейках содержатся имена.
В Лист 2, в строке=1, в ячейках содержатся имена.
Имена в Лист 1 и Лист 2 - сравниваются циклами по столбцам, используем в каждом цикле Cells(x,y).
Если Ячейка.Лист1 совпали Ячейка.Лист2( то тогда совпали и номера столбцов сравниваемых ячеек).
Тогда на Лист1 запускается цикл копирования ячеек строки из Лист 2.
Стартовый адрес копируемых ячеек(Источник) Лист2.Cells(2, номер столбца совпавший)
Адрес назначения Лист1.Cells(3, номер столбца совпавший).
Операция повторяется пока все ячейки Лист2 не будут скопированы в Лист1 по соответствующим ячейкам.
[vba]
Код

То есть кратко-данные из Лист2 скопировать в Лист1 по условию Лист1.Ячейка=Лист2.Ячейка:
Старт:
если sheets(Лист1).Cell(2,2)=sheets(Лист2).Cell(1,2) To (Лист1).Cell(3,2) <-- (Лист2).Cell(2,2)
если sheets(Лист1).Cell(2,3)=sheets(Лист2).Cell(1,3) To (Лист1).Cell(3,3) <-- (Лист2).Cell(2,3)
если sheets(Лист1).Cell(2,4)=sheets(Лист2).Cell(1,4) To (Лист1).Cell(3,4) <-- (Лист2).Cell(2,4)
если sheets(Лист1).Cell(2,5)=sheets(Лист2).Cell(1,5) To (Лист1).Cell(3,5) <-- (Лист2).Cell(2,5)
если sheets(Лист1).Cell(2,6)=sheets(Лист2).Cell(1,6) To (Лист1).Cell(3,6) <-- (Лист2).Cell(2,6)
[/vba]

Чую что нефига не кратенько вышло.
Есть надежда на метод последовательного приближения(к истине, к правде и так далее...)...))))


Сообщение отредактировал alexban65 - Вторник, 09.04.2019, 13:35
 
Ответить
СообщениеЛогика такова:

Активный лист - Лист 1.
В Лист 1, в строке=2, в ячейках содержатся имена.
В Лист 2, в строке=1, в ячейках содержатся имена.
Имена в Лист 1 и Лист 2 - сравниваются циклами по столбцам, используем в каждом цикле Cells(x,y).
Если Ячейка.Лист1 совпали Ячейка.Лист2( то тогда совпали и номера столбцов сравниваемых ячеек).
Тогда на Лист1 запускается цикл копирования ячеек строки из Лист 2.
Стартовый адрес копируемых ячеек(Источник) Лист2.Cells(2, номер столбца совпавший)
Адрес назначения Лист1.Cells(3, номер столбца совпавший).
Операция повторяется пока все ячейки Лист2 не будут скопированы в Лист1 по соответствующим ячейкам.
[vba]
Код

То есть кратко-данные из Лист2 скопировать в Лист1 по условию Лист1.Ячейка=Лист2.Ячейка:
Старт:
если sheets(Лист1).Cell(2,2)=sheets(Лист2).Cell(1,2) To (Лист1).Cell(3,2) <-- (Лист2).Cell(2,2)
если sheets(Лист1).Cell(2,3)=sheets(Лист2).Cell(1,3) To (Лист1).Cell(3,3) <-- (Лист2).Cell(2,3)
если sheets(Лист1).Cell(2,4)=sheets(Лист2).Cell(1,4) To (Лист1).Cell(3,4) <-- (Лист2).Cell(2,4)
если sheets(Лист1).Cell(2,5)=sheets(Лист2).Cell(1,5) To (Лист1).Cell(3,5) <-- (Лист2).Cell(2,5)
если sheets(Лист1).Cell(2,6)=sheets(Лист2).Cell(1,6) To (Лист1).Cell(3,6) <-- (Лист2).Cell(2,6)
[/vba]

Чую что нефига не кратенько вышло.
Есть надежда на метод последовательного приближения(к истине, к правде и так далее...)...))))

Автор - alexban65
Дата добавления - 09.04.2019 в 12:35
skais Дата: Вторник, 09.04.2019, 13:07 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 236
Репутация: 29 ±
Замечаний: 20% ±

Excel 2010
В Лист 1, в строке=5, в ячейках содержатся имена.

Где этот лист и в строке=5 - там пусто! В общем Вы пишите как-то абстрактно не понятно по какому примеру (наверно из Вашей головы)?


Сообщение отредактировал skais - Вторник, 09.04.2019, 13:08
 
Ответить
Сообщение
В Лист 1, в строке=5, в ячейках содержатся имена.

Где этот лист и в строке=5 - там пусто! В общем Вы пишите как-то абстрактно не понятно по какому примеру (наверно из Вашей головы)?

Автор - skais
Дата добавления - 09.04.2019 в 13:07
alexban65 Дата: Вторник, 09.04.2019, 13:24 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Голова - предмет темный, и исследованию не подлежит (С)

Простите великодушно - черт попутал.
Удалил я верхние 3 строки в листе 1 - а мысленно еще там где они есть...(((
Вот так правильно - в Лист1, в строке 2.

Попробовал цикл DO while, тоже как то не очень:
[vba]
Код

a = 1
b = 1
Do While a <= iEndCol
a = a + 1
    Do While b <= lEndCol
    b = b + 1
        If Sheets("ПК").Cells(1, b) = Sheets("Sheet1").Cells(2, a) Then
            'MsgBox Sheets("ПК").Cells(1, b) & " " & b & "  ===  " & a & " " & Sheets("Sheet1").Cells(2, a), , "Вход"
            MsgBox Sheets("ПК").Cells(1, b) & "  ===  " & Sheets("Sheet1").Cells(2, a), , "Вход"
            Exit Do
        End If
    Loop
If Sheets("ПК").Cells(1, b) <> Sheets("Sheet1").Cells(2, a) Then
    MsgBox Sheets("ПК").Cells(1, b) & b & "  ===  " & a & Sheets("Sheet1").Cells(2, a), , "ячейки не равны-неповезло !!!"
End If
Loop
MsgBox " <> END!!!    " & Sheets("Sheet1").Cells(iLastRow, iEndCol)
[/vba]


Сообщение отредактировал alexban65 - Вторник, 09.04.2019, 13:26
 
Ответить
СообщениеГолова - предмет темный, и исследованию не подлежит (С)

Простите великодушно - черт попутал.
Удалил я верхние 3 строки в листе 1 - а мысленно еще там где они есть...(((
Вот так правильно - в Лист1, в строке 2.

Попробовал цикл DO while, тоже как то не очень:
[vba]
Код

a = 1
b = 1
Do While a <= iEndCol
a = a + 1
    Do While b <= lEndCol
    b = b + 1
        If Sheets("ПК").Cells(1, b) = Sheets("Sheet1").Cells(2, a) Then
            'MsgBox Sheets("ПК").Cells(1, b) & " " & b & "  ===  " & a & " " & Sheets("Sheet1").Cells(2, a), , "Вход"
            MsgBox Sheets("ПК").Cells(1, b) & "  ===  " & Sheets("Sheet1").Cells(2, a), , "Вход"
            Exit Do
        End If
    Loop
If Sheets("ПК").Cells(1, b) <> Sheets("Sheet1").Cells(2, a) Then
    MsgBox Sheets("ПК").Cells(1, b) & b & "  ===  " & a & Sheets("Sheet1").Cells(2, a), , "ячейки не равны-неповезло !!!"
End If
Loop
MsgBox " <> END!!!    " & Sheets("Sheet1").Cells(iLastRow, iEndCol)
[/vba]

Автор - alexban65
Дата добавления - 09.04.2019 в 13:24
skais Дата: Вторник, 09.04.2019, 13:31 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 236
Репутация: 29 ±
Замечаний: 20% ±

Excel 2010
то есть мы пытаемся по названиям во 2 строке листа1 подтянуть данные соответствующих столбцов из пк. Однако что будет если дважды копировать - они добавляются или перезаписываем?
 
Ответить
Сообщението есть мы пытаемся по названиям во 2 строке листа1 подтянуть данные соответствующих столбцов из пк. Однако что будет если дважды копировать - они добавляются или перезаписываем?

Автор - skais
Дата добавления - 09.04.2019 в 13:31
alexban65 Дата: Вторник, 09.04.2019, 13:45 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Хотелось бы обойтись без двойного копирования, это сильно замедляет - поскольку столбцов в Лист1 много, а строк в Лист2 может быть в десятки и больше раз больше.
Но если есть двойное копирование - то одинаковые ячейки перезаписывать.
 
Ответить
СообщениеХотелось бы обойтись без двойного копирования, это сильно замедляет - поскольку столбцов в Лист1 много, а строк в Лист2 может быть в десятки и больше раз больше.
Но если есть двойное копирование - то одинаковые ячейки перезаписывать.

Автор - alexban65
Дата добавления - 09.04.2019 в 13:45
skais Дата: Вторник, 09.04.2019, 13:48 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 236
Репутация: 29 ±
Замечаний: 20% ±

Excel 2010
Решение.
[vba]
Код

Private Sub CommandButton3_Click()
    Application.ScreenUpdating = False
    With Sheets("ПК")
        arr2 = .UsedRange.Value
    End With

    With Sheets("Sheet1")
        arr1 = .UsedRange.Value
        .UsedRange.Offset(2, 0).ClearContents

        For i = 1 To UBound(arr1, 2)
            For j = 1 To UBound(arr2, 2)
                If arr1(2, i) = arr2(1, j) Then
                    For h = 2 To UBound(arr2, 1)
                        If arr2(h, j) <> "" Then .Cells(h + 1, i) = arr2(h, j)
                    Next
                    Exit For
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: InventWork-4-.xlsm (47.0 Kb)
 
Ответить
СообщениеРешение.
[vba]
Код

Private Sub CommandButton3_Click()
    Application.ScreenUpdating = False
    With Sheets("ПК")
        arr2 = .UsedRange.Value
    End With

    With Sheets("Sheet1")
        arr1 = .UsedRange.Value
        .UsedRange.Offset(2, 0).ClearContents

        For i = 1 To UBound(arr1, 2)
            For j = 1 To UBound(arr2, 2)
                If arr1(2, i) = arr2(1, j) Then
                    For h = 2 To UBound(arr2, 1)
                        If arr2(h, j) <> "" Then .Cells(h + 1, i) = arr2(h, j)
                    Next
                    Exit For
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - skais
Дата добавления - 09.04.2019 в 13:48
alexban65 Дата: Вторник, 09.04.2019, 14:38 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Нормально.
Сейчас обработаем напильником, под свои нужды.
БЛАГОДАРЮ!
 
Ответить
СообщениеНормально.
Сейчас обработаем напильником, под свои нужды.
БЛАГОДАРЮ!

Автор - alexban65
Дата добавления - 09.04.2019 в 14:38
alexban65 Дата: Среда, 10.04.2019, 10:00 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Погонял решение в разных вариациях.
Поскольку в массивах пока не очень, хотя и стараюсь, то экспериментировал в пределах своих знаний...)))
Решение и код - годное, но, на мой взгляд, жестковатое.
Даже не представляю себе, какой напильник надо для модификации кода...)))
1. Заполнение ячеек на Лист1(видимо, на Лист2 чтение идет тоже так же...) идет сверху вниз - задумывалось заполнять ячейки слева направо.
Так как при заполнения всех ячеек в строке - хотелось бы проанализировать собранную строку, что то вставить по допусловию самостоятельно,
например типа [vba]
Код
IF Sheet("ПК").Unique_Id.Value = Sheet("Ответственные").Container_Unique_Id.Value Then
[/vba] повторять заполнение пока верно условие.
Как в такой реализации, при формировании сверху вниз, добавить то что задумал - пока не представляю.
2. При игре параметрами массив по листу целиком не перемещается - он просто усекается.
Хотелось бы его подвигать вправо, влево, вверх, в низ.
Хотя, вполне возможно, погонял параметры не до конца.
3. Думал что будет больше переменных - так проще адаптировать код для других задач...)))

Претензий, жалоб нет - конечный результат великолепный, именно такой, какой и задумывался, плюс в карму однозначно!
Но, если есть возможность учесть п.1 и п.2 и п.3, или пояснить их....)))


Сообщение отредактировал alexban65 - Среда, 10.04.2019, 10:11
 
Ответить
СообщениеПогонял решение в разных вариациях.
Поскольку в массивах пока не очень, хотя и стараюсь, то экспериментировал в пределах своих знаний...)))
Решение и код - годное, но, на мой взгляд, жестковатое.
Даже не представляю себе, какой напильник надо для модификации кода...)))
1. Заполнение ячеек на Лист1(видимо, на Лист2 чтение идет тоже так же...) идет сверху вниз - задумывалось заполнять ячейки слева направо.
Так как при заполнения всех ячеек в строке - хотелось бы проанализировать собранную строку, что то вставить по допусловию самостоятельно,
например типа [vba]
Код
IF Sheet("ПК").Unique_Id.Value = Sheet("Ответственные").Container_Unique_Id.Value Then
[/vba] повторять заполнение пока верно условие.
Как в такой реализации, при формировании сверху вниз, добавить то что задумал - пока не представляю.
2. При игре параметрами массив по листу целиком не перемещается - он просто усекается.
Хотелось бы его подвигать вправо, влево, вверх, в низ.
Хотя, вполне возможно, погонял параметры не до конца.
3. Думал что будет больше переменных - так проще адаптировать код для других задач...)))

Претензий, жалоб нет - конечный результат великолепный, именно такой, какой и задумывался, плюс в карму однозначно!
Но, если есть возможность учесть п.1 и п.2 и п.3, или пояснить их....)))

Автор - alexban65
Дата добавления - 10.04.2019 в 10:00
skais Дата: Среда, 10.04.2019, 10:41 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 236
Репутация: 29 ±
Замечаний: 20% ±

Excel 2010
alexban65 У Вас был вопрос - он был решен. Что касается других моментов создавайте отдельные темы или одну в разделе работа. У Вас по сути уже не вопрос, а тз.
Да и эта тема тоже имеет широкое понятие. В итоге Вы хотите получить какого-то универсального монстра. Если в нем смысл - или лучше определиться с тз и выполнить и забыть?
Сделать можно все, но это нарушение правил форума - одна тема - один вопрос.
 
Ответить
Сообщениеalexban65 У Вас был вопрос - он был решен. Что касается других моментов создавайте отдельные темы или одну в разделе работа. У Вас по сути уже не вопрос, а тз.
Да и эта тема тоже имеет широкое понятие. В итоге Вы хотите получить какого-то универсального монстра. Если в нем смысл - или лучше определиться с тз и выполнить и забыть?
Сделать можно все, но это нарушение правил форума - одна тема - один вопрос.

Автор - skais
Дата добавления - 10.04.2019 в 10:41
alexban65 Дата: Среда, 10.04.2019, 11:10 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Ладно, коли так - тогда заморачиваться не стоит.
Сделал пока так - создал Лист3, копирую туда данные из Лист2, задаю условия для обработки, получаю аналог Лист2 но с нужными мне данными и параметрами, после того как Лист3 полностью сформируется- забираю данные в Лист1.
Потом, со временем, разберемся...)))

Благодарю за участие!
 
Ответить
СообщениеЛадно, коли так - тогда заморачиваться не стоит.
Сделал пока так - создал Лист3, копирую туда данные из Лист2, задаю условия для обработки, получаю аналог Лист2 но с нужными мне данными и параметрами, после того как Лист3 полностью сформируется- забираю данные в Лист1.
Потом, со временем, разберемся...)))

Благодарю за участие!

Автор - alexban65
Дата добавления - 10.04.2019 в 11:10
_Boroda_ Дата: Среда, 10.04.2019, 11:14 | Сообщение № 13
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
1. При работе на листе по строкам вообще выводить не нужно, просто берем сразу весь нужный столбец и вставляем в найденное место. Третий цикл лишний, тем более, что он очень много времени занимает.
При работе внутри кода (без кучи обращений к листу) да, бегаем еще и по строкам (там это быстро работает)
2. Это Вы про что? Что куда по каким параметрам Вы собираетесь двигать?
3. Какие конкретно переменные Вас интересуют?

Мой вариант макроса с комментариями
[vba]
Код
Sub tt()
    ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив
    Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь
    With slov2 'работаем с этим словарем
        For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2
            .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца
        Next i
        c_ = Cells(2, Columns.Count).End(1).Column 'номер последнего столбца на активном листе
        ar1 = Cells(2, 2).Resize(UBound(ar2), c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1
        For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1
            If .exists(ar1(1, i)) Then 'если такое название есть в словаре
                n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК
                For j = 2 To UBound(ar2, 2) 'цикл по строкам
                    ar1(j, i) = ar2(j, n_) 'перенос строк из массива в массив
                Next j
            End If
        Next i
    End With
    Cells(2, 2).Resize(UBound(ar2), c_ - 1) = ar1 'данные из массива ar1 выносим на лист
End Sub
[/vba]
Код немного поправил, файл перевложил
К сообщению приложен файл: InventWork_21.xlsm (43.2 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение1. При работе на листе по строкам вообще выводить не нужно, просто берем сразу весь нужный столбец и вставляем в найденное место. Третий цикл лишний, тем более, что он очень много времени занимает.
При работе внутри кода (без кучи обращений к листу) да, бегаем еще и по строкам (там это быстро работает)
2. Это Вы про что? Что куда по каким параметрам Вы собираетесь двигать?
3. Какие конкретно переменные Вас интересуют?

Мой вариант макроса с комментариями
[vba]
Код
Sub tt()
    ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив
    Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь
    With slov2 'работаем с этим словарем
        For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2
            .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца
        Next i
        c_ = Cells(2, Columns.Count).End(1).Column 'номер последнего столбца на активном листе
        ar1 = Cells(2, 2).Resize(UBound(ar2), c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1
        For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1
            If .exists(ar1(1, i)) Then 'если такое название есть в словаре
                n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК
                For j = 2 To UBound(ar2, 2) 'цикл по строкам
                    ar1(j, i) = ar2(j, n_) 'перенос строк из массива в массив
                Next j
            End If
        Next i
    End With
    Cells(2, 2).Resize(UBound(ar2), c_ - 1) = ar1 'данные из массива ar1 выносим на лист
End Sub
[/vba]
Код немного поправил, файл перевложил

Автор - _Boroda_
Дата добавления - 10.04.2019 в 11:14
alexban65 Дата: Среда, 10.04.2019, 12:28 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Со словарями - код понятный, читабельный. Хотя по словарям не спец - думаю что разберусь...)
Чую руку мастера...)))
По ощущению - код работает даже быстрее чем чем массивами.
Что то с размерностями - кладет количество строк по количеству столбцов, то есть не выбирает весь диапазон из листа "ПК".
 
Ответить
СообщениеСо словарями - код понятный, читабельный. Хотя по словарям не спец - думаю что разберусь...)
Чую руку мастера...)))
По ощущению - код работает даже быстрее чем чем массивами.
Что то с размерностями - кладет количество строк по количеству столбцов, то есть не выбирает весь диапазон из листа "ПК".

Автор - alexban65
Дата добавления - 10.04.2019 в 12:28
_Boroda_ Дата: Среда, 10.04.2019, 13:43 | Сообщение № 15
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Конечно. Цикл по строкам без ,2)
[vba]
Код
For j = 2 To UBound(ar2) 'цикл по строкам
[/vba]
Файл приложил

По ощущению - код работает даже быстрее чем чем массивами
Особенно развеселило слово "даже". Проверьте хотя бы на 1000 строк, разница в скорости в 23 раза. А на 10000 строк макрос "массивами" вообще завис
К сообщению приложен файл: InventWork_22.xlsm (43.2 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеКонечно. Цикл по строкам без ,2)
[vba]
Код
For j = 2 To UBound(ar2) 'цикл по строкам
[/vba]
Файл приложил

По ощущению - код работает даже быстрее чем чем массивами
Особенно развеселило слово "даже". Проверьте хотя бы на 1000 строк, разница в скорости в 23 раза. А на 10000 строк макрос "массивами" вообще завис

Автор - _Boroda_
Дата добавления - 10.04.2019 в 13:43
alexban65 Дата: Среда, 10.04.2019, 14:22 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Про цикл по строкам понял - по умолчанию размерность массива ставится 1(грубо говоря - это кол-во столбцов)...

Проверил ударно, на 50 000 строк...))) - и ему, однако, не сладко пришлось.
С "массивами" даже не стал прогонять.
 
Ответить
СообщениеПро цикл по строкам понял - по умолчанию размерность массива ставится 1(грубо говоря - это кол-во столбцов)...

Проверил ударно, на 50 000 строк...))) - и ему, однако, не сладко пришлось.
С "массивами" даже не стал прогонять.

Автор - alexban65
Дата добавления - 10.04.2019 в 14:22
alexban65 Дата: Среда, 10.04.2019, 14:36 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Но все равно на активном листе границы массива вправо отрисовывает несколько больше(+8) чем нужно.
Это видно по наличию #Н/Д
 
Ответить
СообщениеНо все равно на активном листе границы массива вправо отрисовывает несколько больше(+8) чем нужно.
Это видно по наличию #Н/Д

Автор - alexban65
Дата добавления - 10.04.2019 в 14:36
_Boroda_ Дата: Среда, 10.04.2019, 15:36 | Сообщение № 18
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Это я не тот файл вложил
Перевложил во всех постах
К сообщению приложен файл: InventWork_4.xlsm (43.1 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭто я не тот файл вложил
Перевложил во всех постах

Автор - _Boroda_
Дата добавления - 10.04.2019 в 15:36
alexban65 Дата: Четверг, 11.04.2019, 08:51 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Я правильно понимаю, что алгоритм копирует шапку в массив, и из массива на лист- в итоге перезаписывая шапку?
Потому как добавил несколько строк в шапку, внес изменения.
Теперь копирует данные с нужной мне позиции, но данные копируется вместе с шапкой...)))

Шапка нужна в словаре, для работы - но в дальнейшем она не нужна.
Пробовал отсечь шапку при переносе из массива в массив - получилось частично.((
В некоторые пустые столбцы шапка все же просочилась.
Видимо, где то по _n идет все таки перезапись?...((
Как поправить?
К сообщению приложен файл: InventWork_4_01.xlsm (43.3 Kb)
 
Ответить
СообщениеЯ правильно понимаю, что алгоритм копирует шапку в массив, и из массива на лист- в итоге перезаписывая шапку?
Потому как добавил несколько строк в шапку, внес изменения.
Теперь копирует данные с нужной мне позиции, но данные копируется вместе с шапкой...)))

Шапка нужна в словаре, для работы - но в дальнейшем она не нужна.
Пробовал отсечь шапку при переносе из массива в массив - получилось частично.((
В некоторые пустые столбцы шапка все же просочилась.
Видимо, где то по _n идет все таки перезапись?...((
Как поправить?

Автор - alexban65
Дата добавления - 11.04.2019 в 08:51
_Boroda_ Дата: Четверг, 11.04.2019, 10:05 | Сообщение № 20
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Чет Вы мудрите всё
Держите
[vba]
Код
Sub tt()
    ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив
    Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь
    With slov2 'работаем с этим словарем
        For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2
            .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца
        Next i
        c_ = Cells(5, Columns.Count).End(1).Column 'номер последнего столбца на активном листе
        ar1 = Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1
        For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1
            If .exists(ar1(1, i)) Then 'если такое название есть в словаре
                 n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК
                For j = 2 To UBound(ar2) 'цикл по строкам '
                   ' Шапка при переносе в массив не нужна(верно j-1)                 ' НЕВЕРНО!
                   'ar1(j, i) = ar2(j, n_)
                    ar1(j + 1, i) = ar2(j, n_) 'перенос строк из массива в массив
                Next j
            End If
        Next i
    End With
    Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1) = ar1 'данные из массива ar1 выносим на лист
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЧет Вы мудрите всё
Держите
[vba]
Код
Sub tt()
    ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив
    Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь
    With slov2 'работаем с этим словарем
        For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2
            .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца
        Next i
        c_ = Cells(5, Columns.Count).End(1).Column 'номер последнего столбца на активном листе
        ar1 = Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1
        For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1
            If .exists(ar1(1, i)) Then 'если такое название есть в словаре
                 n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК
                For j = 2 To UBound(ar2) 'цикл по строкам '
                   ' Шапка при переносе в массив не нужна(верно j-1)                 ' НЕВЕРНО!
                   'ar1(j, i) = ar2(j, n_)
                    ar1(j + 1, i) = ar2(j, n_) 'перенос строк из массива в массив
                Next j
            End If
        Next i
    End With
    Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1) = ar1 'данные из массива ar1 выносим на лист
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 11.04.2019 в 10:05
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!