Не могу найти ответ. Вся надежда на знатоков из этого форума. Переформулировал задачу. может так получится.
В общем есть файл "Primer" и файл "Shema". И нужно данные из файла "Shema" разнести в файле "Primer". Нужно перенести строки из одного файла в столбец другого. При этом следующая ячейка из строки вносится через девять пустых ячеек, другими словами каждая десятая ячейка с данными. Когда заканчиваются данные в первой строке, переносить нужно вторую и т.д. пока есть данные. Потому как в файле "Shema" массив данных может быть очень большим, больше 6 млн ячеек. В файле примере надеюсь понятно, там конечно минимум данных. Когда начал это делать в одном файле, то выдало сообщение что не хватает ресурсов.((
На Вас одна надежда. Заранее спасибо))
Не могу найти ответ. Вся надежда на знатоков из этого форума. Переформулировал задачу. может так получится.
В общем есть файл "Primer" и файл "Shema". И нужно данные из файла "Shema" разнести в файле "Primer". Нужно перенести строки из одного файла в столбец другого. При этом следующая ячейка из строки вносится через девять пустых ячеек, другими словами каждая десятая ячейка с данными. Когда заканчиваются данные в первой строке, переносить нужно вторую и т.д. пока есть данные. Потому как в файле "Shema" массив данных может быть очень большим, больше 6 млн ячеек. В файле примере надеюсь понятно, там конечно минимум данных. Когда начал это делать в одном файле, то выдало сообщение что не хватает ресурсов.((
Как это 6 млн.? Только чуть более 3-х получится, согласно примера... И даже если там по 6 ячеек в каждой строке - куда это всё класть собираетесь? Таких Primer'ов пока ещё нет... А вообще это элементарно делается циклом по ячейкам - один цикл по строке пока есть данные, как закончились переходим на строку ниже. И точно нужно переносить? Тогда проще копировать, а в конце убить все исходные данные.
Как это 6 млн.? Только чуть более 3-х получится, согласно примера... И даже если там по 6 ячеек в каждой строке - куда это всё класть собираетесь? Таких Primer'ов пока ещё нет... А вообще это элементарно делается циклом по ячейкам - один цикл по строке пока есть данные, как закончились переходим на строку ниже. И точно нужно переносить? Тогда проще копировать, а в конце убить все исходные данные.Hugo
Так в пример ж вообще минимум. Откуда Вы взяли 3?? столбиков 2050, а строк 3250. Получается больше 6 млн ячеек. И это минимум, хочется больше.
А на счет цикла, с Вами даже спорить не буду. Но не знаю как)). Поэтому и обратился за помощью. И еще ж не подряд вставлять а в каждую десятую ячейку столбика N, начиная с ячейки N6. Буду признателен если поможете) Спасибо.
Так в пример ж вообще минимум. Откуда Вы взяли 3?? столбиков 2050, а строк 3250. Получается больше 6 млн ячеек. И это минимум, хочется больше.
А на счет цикла, с Вами даже спорить не буду. Но не знаю как)). Поэтому и обратился за помощью. И еще ж не подряд вставлять а в каждую десятую ячейку столбика N, начиная с ячейки N6. Буду признателен если поможете) Спасибо.mefisto
Sub tt() Dim sh As Worksheet, c As Range, i&, ii&, x& Application.ScreenUpdating = False
Set sh = Workbooks("Shema.xlsx").Sheets(1) i = 6 'начальная строка For ii = 1 To sh.Rows.Count If Not IsEmpty(sh.Cells(ii, 1)) Then Application.StatusBar = "Копирую строку " & ii Call procedura(i&, ii&, sh) Else Exit For End If Next
Private Sub procedura(i&, ii&, sh As Object) Dim x& For x = 1 To sh.Columns.Count If Not IsEmpty(sh.Cells(ii, x)) Then sh.Cells(ii, x).Copy Range("N" & i) i = i + 10 'шаг Else Exit For End If Next End Sub
[/vba] Выполнять при открытых обоих файлах и активном окне Primer. Но на второй вопрос так и не ответили - ну сами виноваты, будете сами и дорабатывать.
[vba]
Код
Option Explicit
Sub tt() Dim sh As Worksheet, c As Range, i&, ii&, x& Application.ScreenUpdating = False
Set sh = Workbooks("Shema.xlsx").Sheets(1) i = 6 'начальная строка For ii = 1 To sh.Rows.Count If Not IsEmpty(sh.Cells(ii, 1)) Then Application.StatusBar = "Копирую строку " & ii Call procedura(i&, ii&, sh) Else Exit For End If Next
Private Sub procedura(i&, ii&, sh As Object) Dim x& For x = 1 To sh.Columns.Count If Not IsEmpty(sh.Cells(ii, x)) Then sh.Cells(ii, x).Copy Range("N" & i) i = i + 10 'шаг Else Exit For End If Next End Sub
[/vba] Выполнять при открытых обоих файлах и активном окне Primer. Но на второй вопрос так и не ответили - ну сами виноваты, будете сами и дорабатывать.Hugo
Значит не понял вопроса. Не серчайте. Ваше решение вопроса вроде полностью удовлетворяет. Не понял что нужно дорабатывать. Пошел повышать Вам репутацию). Еще раз спасибо!!!!
Значит не понял вопроса. Не серчайте. Ваше решение вопроса вроде полностью удовлетворяет. Не понял что нужно дорабатывать. Пошел повышать Вам репутацию). Еще раз спасибо!!!!mefisto
Я не предполагал что есть какое-то ограничение. Обработало 1 млн и выдало ERROR. Возможно придется резать файл Shema на куски и обрабатывать частями. Пока не представляю, но буду пробовать. Спасибо!
Я не предполагал что есть какое-то ограничение. Обработало 1 млн и выдало ERROR. Возможно придется резать файл Shema на куски и обрабатывать частями. Пока не представляю, но буду пробовать. Спасибо!mefisto
Вариант - запускать как и прежде. В конце делайте с этими файлами что хотите. Но я бы в коде их сразу и сохранял и закрывал. [vba]
Код
Option Explicit
Sub tt() Dim sh As Worksheet, shablon As Worksheet, c As Range, i&, ii&, x& Application.ScreenUpdating = False
Set shablon = ActiveSheet shablon.Copy
Set sh = Workbooks("Shema.xlsx").Sheets(1) i = 6 'начальная строка For ii = 1 To sh.Rows.Count If Not IsEmpty(sh.Cells(ii, 1)) Then Application.StatusBar = "Копирую строку " & ii Call procedura(i&, ii&, sh, shablon) Else Exit For End If Next
Private Sub procedura(i&, ii&, sh As Object, shablon As Object) Dim x& For x = 1 To sh.Columns.Count If Not IsEmpty(sh.Cells(ii, x)) Then sh.Cells(ii, x).Copy Range("N" & i) i = i + 10 'шаг If i > Rows.Count Then shablon.Copy i = 6 End If Else Exit For End If Next End Sub
[/vba] Можно перед копированием шаблона в процедуре добавить строку [vba]
Код
ActiveWorkbook.Close True
[/vba] Правда придётся в ручном режиме подтверждать сохранение, зато можно оперативно дать какое угодно имя.
Вариант - запускать как и прежде. В конце делайте с этими файлами что хотите. Но я бы в коде их сразу и сохранял и закрывал. [vba]
Код
Option Explicit
Sub tt() Dim sh As Worksheet, shablon As Worksheet, c As Range, i&, ii&, x& Application.ScreenUpdating = False
Set shablon = ActiveSheet shablon.Copy
Set sh = Workbooks("Shema.xlsx").Sheets(1) i = 6 'начальная строка For ii = 1 To sh.Rows.Count If Not IsEmpty(sh.Cells(ii, 1)) Then Application.StatusBar = "Копирую строку " & ii Call procedura(i&, ii&, sh, shablon) Else Exit For End If Next
Private Sub procedura(i&, ii&, sh As Object, shablon As Object) Dim x& For x = 1 To sh.Columns.Count If Not IsEmpty(sh.Cells(ii, x)) Then sh.Cells(ii, x).Copy Range("N" & i) i = i + 10 'шаг If i > Rows.Count Then shablon.Copy i = 6 End If Else Exit For End If Next End Sub
[/vba] Можно перед копированием шаблона в процедуре добавить строку [vba]
Код
ActiveWorkbook.Close True
[/vba] Правда придётся в ручном режиме подтверждать сохранение, зато можно оперативно дать какое угодно имя.Hugo
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
на какой второй вопрос?
