Страницы: 1
RSS
VBA. Перемещение строк между листами с использованием массивов, Помогите доработать макрос.
 
Задача есть 2 файла. Первый файл с ежедневным пополнением строк, второй файл из первого по определенным параметрам необходимо подтянуть данные. В первом файле они должны удалиться во втором накопиться в конце.
Создал макрос с циклом где одна строка копируется вставляется удаляется. но макрос работает довольно таки долго. Попробовал с массивами. Но не могу сообразить как вставлять в последнюю строку и удалять из первого файла строку можно ли это сделать? В массиве ниже данные подтягиваются, но затирают все строки сверху во втором файле и не удаляются.
Код
Sub df()


  Dim SRow As Long
   Dim NRow As Long
   Dim Data_Otgr As String

   Dim ish
   Dim kon
   
   Data_Otgr = nameOper
  

      With Workbooks(moz).Sheets(qq)
       ish = .Range(.[A4], .Cells(.UsedRange.Rows.Count, "R")).Value
   End With
  

   ReDim kon(1 To UBound(ish), 1 To 18)

   For SRow = 1 To UBound(ish)
       If Data_Otgr = ish(SRow, 18) Then
           NRow = NRow + 1
           '===>
           kon(NRow, 1) = ish(SRow, 1)
           kon(NRow, 2) = ish(SRow, 2)
           kon(NRow, 3) = ish(SRow, 3)
           kon(NRow, 4) = ish(SRow, 4)
           kon(NRow, 5) = ish(SRow, 5)
           kon(NRow, 6) = ish(SRow, 6)
           kon(NRow, 7) = ish(SRow, 7)
           kon(NRow,  = ish(SRow, 
           kon(NRow, 9) = ish(SRow, 9)
           kon(NRow, 10) = ish(SRow, 10)
           kon(NRow, 11) = ish(SRow, 11)
           kon(NRow, 12) = ish(SRow, 12)
           kon(NRow, 13) = ish(SRow, 13)
           kon(NRow, 14) = ish(SRow, 14)
           kon(NRow, 15) = ish(SRow, 15)
           kon(NRow, 16) = ish(SRow, 16)
           kon(NRow, 17) = ish(SRow, 17)
           kon(NRow, 18) = ish(SRow, 18)
           '===>
       End If
   Next SRow
   If NRow = 0 Then
       MsgBox "í"
   Else
      Workbooks(namess).Sheets(qq).range("A4:R4").Rsize(NRow) = kon
      
   End If

End Sub
Изменено: fynt1l - 18.07.2019 09:21:03
 
fynt1l, код следует оформлять соответствующим тегом. Ищите такую кнопку (см. скрин) и исправьте своё сообщение.
И предложите новое название темы, из которого будет понятна проблема/задача - модераторы поменяют.
Не помешает небольшой файл-пример.
 
Тема: VBA. Перемещение строк между листами с использованием массивов
Без файлов как-то так (не проверял)
Скрытый текст


Согласие есть продукт при полном непротивлении сторон
 
а давай те теперь проведем работу с массивами без массивов
с какого диапазона в какой должны попасть данные можно узнать?
без кодов, шифров, явок. ставок и прочей шпиогской лабуды, а просто своими словами опишите задачу ссылаясь на имена листов, адреса диапазонов
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Проблема быстродействия макроса. Как решить с помощью массивов. Тема.

Создал файл в нем со страницы Reestrs надо перенести данные на страницу reestrs1. по параметру Sheets(reestrs).cells(i,18)= Sheets(reestrs1).cells(1,1).
На листе reestrs1  эти строки должны добавиться в конец на листе reestrs удалиться. С помощью массивов.
sanja тот код не работает.
Изменено: fynt1l - 18.07.2019 09:36:46
 
Цитата
fynt1l написал: Проблема быстродействия макроса. Как решить с помощью массивов. Тема.
Все давно предложено за Вас. См. сообщение #3
Согласие есть продукт при полном непротивлении сторон
 
Sanja, код не работает в этой строке  kon(N, J) = ish(SRow, J)
 
Все SRow в моем коде замените на I (английская И)
Код
kon(N, J) = ish(I, J) и т.п.
Согласие есть продукт при полном непротивлении сторон
 
Sanja, Все строки то что были до этого удаляются. Вставляются только новые данные. Можешь глянуть пример из приложенного файла. сообщение №5. В свой макрос я внедрю мне бы понять как чтобы из одного места удалялось а в другое в конец вставлялось.
 
Привет!
Цитата
fynt1l написал:
На листе reestrs1  эти строки должны добавиться в конец на листе reestrs удалиться.
Лист reestrs  скопируйте, на скопированном листе удалите ненужные строки, теперь можно с этого листа разом скопировать-вставить в нужное место в reestrs1.
Затем удалите ненужные на листе reestrs.
Сравнение прайсов, таблиц - без настроек
 
Inexsu, так вот я и хочу понять кодом как сделать чтобы вставляло в конец .
 
Привет!
Код
Function Строка_Свободная( _
        ws As Worksheet) _
        As Long

    Dim r As Range

    Set r = ws.Cells.Find(what:="*", SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious)

    If r Is Nothing Then

        Строка_Свободная = 1

    Else

        Строка_Свободная = r.Row + 1

    End If

End Function
Сравнение прайсов, таблиц - без настроек
Страницы: 1
Наверх