Макрос для переноса данных из одного файла в другой - Мир MS Excel

Регистрация

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

= Мир MS Excel/Макрос для переноса данных из одного файла в другой - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для переноса данных из одного файла в другой

Макрос для переноса данных из одного файла в другой

Дата: Четверг, 17.01.2013, 16:37 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Помогите пожалуйста.
Очень нужен макрос, но нет опыта в написании. Автоматическим макросом не получается выполнить все требования.
Суть в чем: есть два файла – форма 1 и форма 2 (общий список) Необходимо данные из файла №1 перенести в общий список (Форма 2). Файл 1 всегда стандартный, меняется только данные.
Алгоритм такой: Сначала копируется в форму 2 номер исполнительного листа, если он уже есть в списке, то находит эту строку и меняет ее, если нет в списке – с новой строки создает запись. Далее в эту строку подтягивает все остальные данные с формы 1 (ФИО, основной долг, удержания….все по таблице). В конце строки вставляет текущую дату.
Не могу понять как это все сотворить, помогите у кого есть возможность и знания

К сообщению приложен файл: _1.xlsx (10.7 Kb) · _2--.xlsx (35.6 Kb)

Сообщение отредактировал Pelena - Четверг, 17.01.2013, 16:51

Ответить

Дата: Четверг, 17.01.2013, 18:03 | Сообщение № 2

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 3 ±

Замечаний: 0% ±

Добрый вечер, уважаемый Omeg!

Пометте цветом, пожалуйста, блоки формы, количество строк в которых может изменятся. Или же форма неизменна ни по строкам ни по столбцам?

Путей к вершине множество. Этот один из многих...

Ответить

Дата: Четверг, 17.01.2013, 19:14 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Добрый вечер, уважаемый GWolf!
Пометил строки, количество которых может изменяться. Если это сильно осложняет положение, можно количество полей оставить в таком виде)
Спасибо что откликнулись, два дня сижу с книгой по VBA, но опыта нет, до этого не приходилась делать такие задачи. Очень трудно сразу сообразить что к чему((

К сообщению приложен файл: 0058050.xlsx (10.8 Kb)

Ответить

Дата: Четверг, 17.01.2013, 19:56 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 3 ±

Замечаний: 0% ±

Доброй ночи, уважаемый Omeg!

Пока ждал от Вас ответа, набросал макрос для неизменного количества строк в файле-источнике:

[vba]

Код

Sub AddToBase_Щелкнуть()
      '
      Dim tPath As String
      Dim wbOp As Object
      Dim stroka As String
      Dim flag As Boolean

      Dim P_familija As String, P_imja  As String, P_otcestwo  As String
      Dim P_NomIspList  As String
      Dim P_SumOsnDolg  As String, P_SumUderj  As String, P_SumPerecisl  As String

      P_familija = "" '- Фамилия
      P_imja = "" '- Имя
      P_otcestwo = "" '- Отчество
      P_NomIspList = "" '- Номер исполнительного листа
      P_SumOsnDolg = "" '- Сумма основного долга --> Начальный баланс
      P_SumUderj = "" '- Сумма удержанная
      P_SumPerecisl = "" '- Сумма начисленная

      'заполним переменные значениями
      With ThisWorkbook.ActiveSheet
          P_familija = .Cells(5, 1).Text
          P_imja = .Cells(6, 1).Text
          P_otcestwo = .Cells(7, 1).Text
          P_NomIspList = .Cells(10, 1).Text
          P_SumOsnDolg = .Cells(12, 3).Text
          P_SumUderj = .Cells(31, 2).Text
          P_SumPerecisl = .Cells(31, 4).Text
      End With

      'откроем файл-приемник
      '-- определим путь к файлу-приемнику и, если он лежит в той же папке, что и _
          файл-источник, то путь определяем при помощи .Path
      tPath = ""
      tPath = ThisWorkbook.Path
      'открываем файл-приемник с занесением его в объектную переменную
      Set wbOp = Workbooks.Open(Filename:=tPath & "\_2--.xlsm")

      With wbOp '- в файле-приемнике
          With .Worksheets("Лист1") '- на листе "Лист1"
              flag = False '- значение флага для результата поиска
              nR = 5 '- стартовое значение счетчика (№ строки начала поиска)
              Do '- "бежать по кругу пока не ...
                  stroka = .Cells(nR, 5).Value '- в переменную stroka значение из текущей строки
                  If stroka = P_NomIspList Then '- если значение переменной = значение P_NomIspList (эталона), то
                     flag = True '- флаг в ИСТИНА
                      Exit Do '- прервать цикл
                  End If
                  nR = nR + 1 '- изменение значения счетчика строк
              Loop While .Cells(nR, 1).Text <> "" '... будет ячейка пуста

              'после того как цикл прерван или завершился, анализируем флаг
              If flag = True Then '- нашли совпадающий
                  With .Cells(nR, 6) '- Начальный баланс
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumOsnDolg
                  End With
                  With .Cells(nR, 7) '- Сумма удержанная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumUderj
                  End With
                  With .Cells(nR, 8) '- Сумма перечисленная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumPerecisl
                  End With
                  With .Cells(nR, 9) '- Остаток долга
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = CStr(CDbl(P_SumOsnDolg) + CDbl(P_SumUderj) - CDbl(P_SumPerecisl)) '- Остаток долга
                  End With
                  .Cells(nR, 10) = Date '- Дата
              Else '- не нашли совпадающий
                  .Cells(nR, 1) = .Cells(nR - 1, 1).Value + 1 '- № п.п.
                  .Cells(nR, 2) = P_familija '- Фамилия
                  .Cells(nR, 3) = P_imja '- Имя
                  .Cells(nR, 4) = P_otcestwo '- Отчество
                  .Cells(nR, 5) = P_NomIspList '- Номер исполнительного листа
                  With .Cells(nR, 6) '- Начальный баланс
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumOsnDolg
                  End With
                  With .Cells(nR, 7) '- Сумма удержанная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumUderj
                  End With
                  With .Cells(nR, 8) '- Сумма перечисленная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumPerecisl
                  End With
                  With .Cells(nR, 9) '- Остаток долга
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = CStr(CDbl(P_SumOsnDolg) + CDbl(P_SumUderj) - CDbl(P_SumPerecisl)) '- Остаток долга
                  End With
                  .Cells(nR, 10) = Date '- Дата
              End If
          End With

          nR = 0 '- обнуляем счетчик
          'закроем файл-приемник с сохранением
          .Close SaveChanges:=True
      End With
      Set wbOp = Nothing '- чистим объектную переменную

      'очистим значения переменных
      P_familija = ""
      P_imja = ""
      P_otcestwo = ""
      P_NomIspList = ""
      P_SumOsnDolg = ""
      P_SumUderj = ""
      P_SumPerecisl = ""
End Sub

[/vba]

полагаю, что в виду того, что Вы

Цитата (Omeg)

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

мой труд не будет бесполезен. Для случая с изменяющимися координатами "Итого начислено" и "Итого удержано" код будет несколько другим. Если будете иметь немного терпения то я таки и его Вам напишу!
С уважением GWolf.

Доброй ночи, уважаемый Omeg!

Пока ждал от Вас ответа, набросал макрос для неизменного количества строк в файле-источнике:

[vba]

Код

Sub AddToBase_Щелкнуть()
      '
      Dim tPath As String
      Dim wbOp As Object
      Dim stroka As String
      Dim flag As Boolean

      Dim P_familija As String, P_imja  As String, P_otcestwo  As String
      Dim P_NomIspList  As String
      Dim P_SumOsnDolg  As String, P_SumUderj  As String, P_SumPerecisl  As String

      P_familija = "" '- Фамилия
      P_imja = "" '- Имя
      P_otcestwo = "" '- Отчество
      P_NomIspList = "" '- Номер исполнительного листа
      P_SumOsnDolg = "" '- Сумма основного долга --> Начальный баланс
      P_SumUderj = "" '- Сумма удержанная
      P_SumPerecisl = "" '- Сумма начисленная

      'заполним переменные значениями
      With ThisWorkbook.ActiveSheet
          P_familija = .Cells(5, 1).Text
          P_imja = .Cells(6, 1).Text
          P_otcestwo = .Cells(7, 1).Text
          P_NomIspList = .Cells(10, 1).Text
          P_SumOsnDolg = .Cells(12, 3).Text
          P_SumUderj = .Cells(31, 2).Text
          P_SumPerecisl = .Cells(31, 4).Text
      End With

      'откроем файл-приемник
      '-- определим путь к файлу-приемнику и, если он лежит в той же папке, что и _
          файл-источник, то путь определяем при помощи .Path
      tPath = ""
      tPath = ThisWorkbook.Path
      'открываем файл-приемник с занесением его в объектную переменную
      Set wbOp = Workbooks.Open(Filename:=tPath & "\_2--.xlsm")

      With wbOp '- в файле-приемнике
          With .Worksheets("Лист1") '- на листе "Лист1"
              flag = False '- значение флага для результата поиска
              nR = 5 '- стартовое значение счетчика (№ строки начала поиска)
              Do '- "бежать по кругу пока не ...
                  stroka = .Cells(nR, 5).Value '- в переменную stroka значение из текущей строки
                  If stroka = P_NomIspList Then '- если значение переменной = значение P_NomIspList (эталона), то
                     flag = True '- флаг в ИСТИНА
                      Exit Do '- прервать цикл
                  End If
                  nR = nR + 1 '- изменение значения счетчика строк
              Loop While .Cells(nR, 1).Text <> "" '... будет ячейка пуста

              'после того как цикл прерван или завершился, анализируем флаг
              If flag = True Then '- нашли совпадающий
                  With .Cells(nR, 6) '- Начальный баланс
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumOsnDolg
                  End With
                  With .Cells(nR, 7) '- Сумма удержанная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumUderj
                  End With
                  With .Cells(nR, 8) '- Сумма перечисленная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumPerecisl
                  End With
                  With .Cells(nR, 9) '- Остаток долга
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = CStr(CDbl(P_SumOsnDolg) + CDbl(P_SumUderj) - CDbl(P_SumPerecisl)) '- Остаток долга
                  End With
                  .Cells(nR, 10) = Date '- Дата
              Else '- не нашли совпадающий
                  .Cells(nR, 1) = .Cells(nR - 1, 1).Value + 1 '- № п.п.
                  .Cells(nR, 2) = P_familija '- Фамилия
                  .Cells(nR, 3) = P_imja '- Имя
                  .Cells(nR, 4) = P_otcestwo '- Отчество
                  .Cells(nR, 5) = P_NomIspList '- Номер исполнительного листа
                  With .Cells(nR, 6) '- Начальный баланс
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumOsnDolg
                  End With
                  With .Cells(nR, 7) '- Сумма удержанная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumUderj
                  End With
                  With .Cells(nR, 8) '- Сумма перечисленная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumPerecisl
                  End With
                  With .Cells(nR, 9) '- Остаток долга
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = CStr(CDbl(P_SumOsnDolg) + CDbl(P_SumUderj) - CDbl(P_SumPerecisl)) '- Остаток долга
                  End With
                  .Cells(nR, 10) = Date '- Дата
              End If
          End With

          nR = 0 '- обнуляем счетчик
          'закроем файл-приемник с сохранением
          .Close SaveChanges:=True
      End With
      Set wbOp = Nothing '- чистим объектную переменную

      'очистим значения переменных
      P_familija = ""
      P_imja = ""
      P_otcestwo = ""
      P_NomIspList = ""
      P_SumOsnDolg = ""
      P_SumUderj = ""
      P_SumPerecisl = ""
End Sub

[/vba]

полагаю, что в виду того, что Вы

Цитата (Omeg)

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

мой труд не будет бесполезен. Для случая с изменяющимися координатами "Итого начислено" и "Итого удержано" код будет несколько другим. Если будете иметь немного терпения то я таки и его Вам напишу!
С уважением GWolf.GWolf

К сообщению приложен файл: _1.xlsm (32.1 Kb) · _2-.xlsm (33.4 Kb)

Путей к вершине множество. Этот один из многих...

Сообщение отредактировал GWolf - Четверг, 17.01.2013, 20:01

Ответить

СообщениеДоброй ночи, уважаемый Omeg!

Пока ждал от Вас ответа, набросал макрос для неизменного количества строк в файле-источнике:

[vba]

Код

Sub AddToBase_Щелкнуть()
      '
      Dim tPath As String
      Dim wbOp As Object
      Dim stroka As String
      Dim flag As Boolean

      Dim P_familija As String, P_imja  As String, P_otcestwo  As String
      Dim P_NomIspList  As String
      Dim P_SumOsnDolg  As String, P_SumUderj  As String, P_SumPerecisl  As String

      P_familija = "" '- Фамилия
      P_imja = "" '- Имя
      P_otcestwo = "" '- Отчество
      P_NomIspList = "" '- Номер исполнительного листа
      P_SumOsnDolg = "" '- Сумма основного долга --> Начальный баланс
      P_SumUderj = "" '- Сумма удержанная
      P_SumPerecisl = "" '- Сумма начисленная

      'заполним переменные значениями
      With ThisWorkbook.ActiveSheet
          P_familija = .Cells(5, 1).Text
          P_imja = .Cells(6, 1).Text
          P_otcestwo = .Cells(7, 1).Text
          P_NomIspList = .Cells(10, 1).Text
          P_SumOsnDolg = .Cells(12, 3).Text
          P_SumUderj = .Cells(31, 2).Text
          P_SumPerecisl = .Cells(31, 4).Text
      End With

      'откроем файл-приемник
      '-- определим путь к файлу-приемнику и, если он лежит в той же папке, что и _
          файл-источник, то путь определяем при помощи .Path
      tPath = ""
      tPath = ThisWorkbook.Path
      'открываем файл-приемник с занесением его в объектную переменную
      Set wbOp = Workbooks.Open(Filename:=tPath & "\_2--.xlsm")

      With wbOp '- в файле-приемнике
          With .Worksheets("Лист1") '- на листе "Лист1"
              flag = False '- значение флага для результата поиска
              nR = 5 '- стартовое значение счетчика (№ строки начала поиска)
              Do '- "бежать по кругу пока не ...
                  stroka = .Cells(nR, 5).Value '- в переменную stroka значение из текущей строки
                  If stroka = P_NomIspList Then '- если значение переменной = значение P_NomIspList (эталона), то
                     flag = True '- флаг в ИСТИНА
                      Exit Do '- прервать цикл
                  End If
                  nR = nR + 1 '- изменение значения счетчика строк
              Loop While .Cells(nR, 1).Text <> "" '... будет ячейка пуста

              'после того как цикл прерван или завершился, анализируем флаг
              If flag = True Then '- нашли совпадающий
                  With .Cells(nR, 6) '- Начальный баланс
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumOsnDolg
                  End With
                  With .Cells(nR, 7) '- Сумма удержанная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumUderj
                  End With
                  With .Cells(nR, 8) '- Сумма перечисленная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumPerecisl
                  End With
                  With .Cells(nR, 9) '- Остаток долга
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = CStr(CDbl(P_SumOsnDolg) + CDbl(P_SumUderj) - CDbl(P_SumPerecisl)) '- Остаток долга
                  End With
                  .Cells(nR, 10) = Date '- Дата
              Else '- не нашли совпадающий
                  .Cells(nR, 1) = .Cells(nR - 1, 1).Value + 1 '- № п.п.
                  .Cells(nR, 2) = P_familija '- Фамилия
                  .Cells(nR, 3) = P_imja '- Имя
                  .Cells(nR, 4) = P_otcestwo '- Отчество
                  .Cells(nR, 5) = P_NomIspList '- Номер исполнительного листа
                  With .Cells(nR, 6) '- Начальный баланс
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumOsnDolg
                  End With
                  With .Cells(nR, 7) '- Сумма удержанная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumUderj
                  End With
                  With .Cells(nR, 8) '- Сумма перечисленная
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = P_SumPerecisl
                  End With
                  With .Cells(nR, 9) '- Остаток долга
                      .NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
                      .Value = CStr(CDbl(P_SumOsnDolg) + CDbl(P_SumUderj) - CDbl(P_SumPerecisl)) '- Остаток долга
                  End With
                  .Cells(nR, 10) = Date '- Дата
              End If
          End With

          nR = 0 '- обнуляем счетчик
          'закроем файл-приемник с сохранением
          .Close SaveChanges:=True
      End With
      Set wbOp = Nothing '- чистим объектную переменную

      'очистим значения переменных
      P_familija = ""
      P_imja = ""
      P_otcestwo = ""
      P_NomIspList = ""
      P_SumOsnDolg = ""
      P_SumUderj = ""
      P_SumPerecisl = ""
End Sub

[/vba]

полагаю, что в виду того, что Вы

Цитата (Omeg)

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

мой труд не будет бесполезен. Для случая с изменяющимися координатами "Итого начислено" и "Итого удержано" код будет несколько другим. Если будете иметь немного терпения то я таки и его Вам напишу!
С уважением GWolf.

Автор - GWolf
Дата добавления - 17.01.2013 в 19:56

Дата: Четверг, 17.01.2013, 20:07 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Спасибо Огромное!!!!! Вы меня очень выручили!!!! Я бы не справился точно!!!
Уважаемы GWolf, если у вас будет свободное время и желание, напишите пожалуйста еще для случая с изменяющимися координатами "Итого начислено" и "Итого удержано".
Я Вам крайне благодарен! Вы правда меня очень выручили))

Ответить

Дата: Четверг, 17.01.2013, 20:34 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 3 ±

Замечаний: 0% ±

Цитата (Omeg)

для случая с изменяющимися координатами "Итого начислено" и "Итого удержано"

на скрепке.
В файле:
- по зеленой кнопке - с неизменными координатами;
- по смайлику "Улыбка" - с изменяющимися координатами "Итого начислено" и "Итого удержано"

Успехов! Обращайтесь...
С уважением GWolf.

К сообщению приложен файл: 9311104.xlsm (33.1 Kb)

Путей к вершине множество. Этот один из многих...

Сообщение отредактировал GWolf - Четверг, 17.01.2013, 20:39

Ответить

Дата: Четверг, 17.01.2013, 21:38 | Сообщение № 7

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Спасибо огромное!

Ответить

Дата: Пятница, 18.01.2013, 13:23 | Сообщение № 8

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Сегодня тестил, отлично работает. Только второй вариант ошибку почему то выдает, отмечает первую строку в макросе, не могу понять что ему нужно. Но первый вариант работает, пользуюсь им. Еще раз спасибо!

Ответить

Дата: Понедельник, 21.01.2013, 08:37 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 3 ±

Замечаний: 0% ±

Доброго дня, уважаемый Omeg!

Вы писали:

Цитата (Omeg)

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

Посмотрел код, действительно это моя недоработка, за что приношу свои извинения. Старый вариант кода: [vba]

Код

Sub AddInFlOu_Щелкнуть()
       'Ответ на нажатие смайлика "Улыбка"
       Dim tPath As String
       Dim wbOp As Object
       Dim stroka As String
       Dim flag As Boolean
       Dim nR As Long, nREndFrm As Long

       Dim P_familija As String, P_imja  As String, P_otcestwo  As String
       Dim P_NomIspList  As String
       Dim P_SumOsnDolg  As String, P_SumUderj  As String, P_SumPerecisl  As String

       nREndFrm = 4
       Do
           nREndFrm = nREndFrm + 1
       Loop While .Cells(nREndFrm, 1).Text <> "Итого удержано"

       If nREndFrm = 65000 Then MsgBox "Что-то с формой не так!?" & Chr(10) & _
                      "Не могу найти ячейку в первой колонке" & Chr(10) & _
                      "с фразой <Итого удержано>", vbInformation + vbOKOnly, "Нештатное завершение!"

[/vba]

В строке [vba]

Код

Loop While .Cells(nREndFrm, 1).Text <> "Итого удержано"

[/vba] точка, с которой начинается "фраза" указывает что у "фразы" есть начало. Обычно это конструкция With ... End With. В данном случае я счел нецелесообразным применение такой конструкции, но "фразу" не поправил - поторопился. Т.о. строка кода должена выглядеть так:
[vba]

Код

Loop While ThisWorkbook.ActiveSheet.Cells(nREndFrm, 1).Text <> "Итого удержано"

[/vba]

В прилагаемом файле ошибка мною исправлена.

Доброго дня, уважаемый Omeg!

Вы писали:

Цитата (Omeg)

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

Посмотрел код, действительно это моя недоработка, за что приношу свои извинения. Старый вариант кода: [vba]

Код

Sub AddInFlOu_Щелкнуть()
       'Ответ на нажатие смайлика "Улыбка"
       Dim tPath As String
       Dim wbOp As Object
       Dim stroka As String
       Dim flag As Boolean
       Dim nR As Long, nREndFrm As Long

       Dim P_familija As String, P_imja  As String, P_otcestwo  As String
       Dim P_NomIspList  As String
       Dim P_SumOsnDolg  As String, P_SumUderj  As String, P_SumPerecisl  As String

       nREndFrm = 4
       Do
           nREndFrm = nREndFrm + 1
       Loop While .Cells(nREndFrm, 1).Text <> "Итого удержано"

       If nREndFrm = 65000 Then MsgBox "Что-то с формой не так!?" & Chr(10) & _
                      "Не могу найти ячейку в первой колонке" & Chr(10) & _
                      "с фразой <Итого удержано>", vbInformation + vbOKOnly, "Нештатное завершение!"

[/vba]

В строке [vba]

Код

Loop While .Cells(nREndFrm, 1).Text <> "Итого удержано"

[/vba] точка, с которой начинается "фраза" указывает что у "фразы" есть начало. Обычно это конструкция With ... End With. В данном случае я счел нецелесообразным применение такой конструкции, но "фразу" не поправил - поторопился. Т.о. строка кода должена выглядеть так:
[vba]

Код

Loop While ThisWorkbook.ActiveSheet.Cells(nREndFrm, 1).Text <> "Итого удержано"

[/vba]

В прилагаемом файле ошибка мною исправлена.GWolf

К сообщению приложен файл: 9311104_v2.xlsm (36.4 Kb)

Путей к вершине множество. Этот один из многих...

Сообщение отредактировал GWolf - Понедельник, 21.01.2013, 08:43

Ответить

СообщениеДоброго дня, уважаемый Omeg!

Вы писали:

Цитата (Omeg)

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

Посмотрел код, действительно это моя недоработка, за что приношу свои извинения. Старый вариант кода: [vba]

Код

Sub AddInFlOu_Щелкнуть()
       'Ответ на нажатие смайлика "Улыбка"
       Dim tPath As String
       Dim wbOp As Object
       Dim stroka As String
       Dim flag As Boolean
       Dim nR As Long, nREndFrm As Long

       Dim P_familija As String, P_imja  As String, P_otcestwo  As String
       Dim P_NomIspList  As String
       Dim P_SumOsnDolg  As String, P_SumUderj  As String, P_SumPerecisl  As String

       nREndFrm = 4
       Do
           nREndFrm = nREndFrm + 1
       Loop While .Cells(nREndFrm, 1).Text <> "Итого удержано"

       If nREndFrm = 65000 Then MsgBox "Что-то с формой не так!?" & Chr(10) & _
                      "Не могу найти ячейку в первой колонке" & Chr(10) & _
                      "с фразой <Итого удержано>", vbInformation + vbOKOnly, "Нештатное завершение!"

[/vba]

В строке [vba]

Код

Loop While .Cells(nREndFrm, 1).Text <> "Итого удержано"

[/vba] точка, с которой начинается "фраза" указывает что у "фразы" есть начало. Обычно это конструкция With ... End With. В данном случае я счел нецелесообразным применение такой конструкции, но "фразу" не поправил - поторопился. Т.о. строка кода должена выглядеть так:
[vba]

Код

Loop While ThisWorkbook.ActiveSheet.Cells(nREndFrm, 1).Text <> "Итого удержано"

[/vba]

В прилагаемом файле ошибка мною исправлена.

Автор - GWolf
Дата добавления - 21.01.2013 в 08:37

Дата: Понедельник, 21.01.2013, 09:26 | Сообщение № 10

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Все заработало идеально!! Спасибо огромное за помощь!!!!

Ответить

Дата: Понедельник, 21.01.2013, 16:49 | Сообщение № 11

Группа: Проверенные

Ранг: Обитатель

Сообщений: 290

Репутация: 12 ±

Замечаний: 0% ±

Цитата (Omeg)

Все заработало идеально!! Спасибо огромное за помощь!!!!
Все заработало идеально!! Спасибо огромное за помощь!!!!Omeg

Доброго дня всем!
Omeg
Если это возможно, выложите пожалуйста свой работающий файл на форум. А то у меня во вновь созданую книгу (на чистый лист) одна строка копируется , но только одна строка ИТОГов. А вот меняю ФИО на другое, чтобы продолжить список, и не копирует. Копирует только, когда вручную удаляю предыдущую строку.
В то же время, если я правильно понял условия задачи, новые даные, то есть, новая строка с другими даными, должна добавляться в список (ниже предыдущей).
А вот у ваш шаблон, совсем ничего не копирует.

К сообщению приложен файл: 1686785.rar (37.4 Kb)

С ув. Муля!

Ответить

Дата: Вторник, 22.01.2013, 12:43 | Сообщение № 12

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Здраствуйте! У меня схожая проблема с Omeg, только порядок действий не много другой. Есть форма отчетности (в ней меняется только кол-во строк max значение 80 строк) и сводная таблица этих форм. Суть проблемы в том что бы загрузить данные из закрытого файла формы отчетности в открытый файл сводной таблицы.
Здесь на форуме нашел внушительный список макросов, среди которых есть вот такие:

Я думаю что эти макросы должны участвовать в данной выгрузке, но как их правильно применить не хватает навыков sad

sad

Если кому не трудно, прошу поставить на путь истинный в написании данной задачи)

К сообщению прилагаю файл отчетной формы и сводной формы. Заранее спасибо тем кто откликнется:)

[admin]DiRT_ms, оформляйте коды тегами![/admin]

Здраствуйте! У меня схожая проблема с Omeg, только порядок действий не много другой. Есть форма отчетности (в ней меняется только кол-во строк max значение 80 строк) и сводная таблица этих форм. Суть проблемы в том что бы загрузить данные из закрытого файла формы отчетности в открытый файл сводной таблицы.
Здесь на форуме нашел внушительный список макросов, среди которых есть вот такие:

Я думаю что эти макросы должны участвовать в данной выгрузке, но как их правильно применить не хватает навыков sad

sad

Если кому не трудно, прошу поставить на путь истинный в написании данной задачи)

К сообщению прилагаю файл отчетной формы и сводной формы. Заранее спасибо тем кто откликнется:)

[admin]DiRT_ms, оформляйте коды тегами![/admin]DiRT_ms

К сообщению приложен файл: SVOD.xlsx (27.1 Kb) · fail1.xlsx (11.6 Kb)

Сообщение отредактировал DiRT_ms - Среда, 23.01.2013, 10:27

Ответить

СообщениеЗдраствуйте! У меня схожая проблема с Omeg, только порядок действий не много другой. Есть форма отчетности (в ней меняется только кол-во строк max значение 80 строк) и сводная таблица этих форм. Суть проблемы в том что бы загрузить данные из закрытого файла формы отчетности в открытый файл сводной таблицы.
Здесь на форуме нашел внушительный список макросов, среди которых есть вот такие:

Я думаю что эти макросы должны участвовать в данной выгрузке, но как их правильно применить не хватает навыков sad

sad

Если кому не трудно, прошу поставить на путь истинный в написании данной задачи)

К сообщению прилагаю файл отчетной формы и сводной формы. Заранее спасибо тем кто откликнется:)

[admin]DiRT_ms, оформляйте коды тегами![/admin]

Автор - DiRT_ms
Дата добавления - 22.01.2013 в 12:43

Дата: Четверг, 31.01.2013, 13:29 | Сообщение № 13

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 3 ±

Замечаний: 0% ±

Добрый день!

Цитата (DiRT_ms)

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

Если немножичко погуглить интернет, то можно выяснить следующую особенность: Если нам нужно загрузить из ЗАКРЫТОЙ книги данные, то мы эту книгу должны таки ОТКРЫТЬ, только не руками, а программно! Ну а дальше все как всегда: идем по записям ищем то, что нам нужно и переносим туда куда нужно. После такой "прогулки" незабываем книгу-источник ЗАКРЫТЬ, опять же программно!

Вы можете спросить: - Почему нет кода? - Ответ прост! Код есть! Сообщение № 4. Если кто не понял - спрашивайте - отвечу.

Путей к вершине множество. Этот один из многих...

Сообщение отредактировал GWolf - Четверг, 31.01.2013, 13:33

Ответить

Дата: Вторник, 16.04.2013, 20:48 | Сообщение № 14

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Добрый день! Прощу о помощи. не могу объединить макрос переноса данных из одного файла в другой с функцией ВПР.
есть два файла (книга 1 и книга 2 - названия всегда разные). В книгу 1 нужно перенести данные по обещанной цене из книги 2.
Помогите кому не трудно.

К сообщению приложен файл: _1.xls (52.5 Kb)

Сообщение отредактировал alya - Вторник, 16.04.2013, 20:56

Ответить

Дата: Вторник, 16.04.2013, 20:50 | Сообщение № 15

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

книга 2

Сообщение отредактировал alya - Вторник, 16.04.2013, 20:56

Ответить

Дата: Суббота, 24.05.2014, 20:37 | Сообщение № 16

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Всем, доброй ночи!
У меня есть маленькая проблема в работе макроса.
Суть задания: из файла "по бригадам.xls" найти итоговые суммы по определенным строкам и записать в файл "форма.xls". Это я реализовала.
А теперь проблемка. Например: нужно найти строку "Компенсация отпуска". В файле "по бригадам.xls" в 01 бригаде 00 участок такой записи нет, и значит в файле "форма.xls" должно быть пусто. А макрос находит эту запись в другой бригаде(03 бригада 02 участок) и записывает в 01 бригаду 00 участок.
Не могу понять как это сотворить,помогите у кого есть возможность и знания.

К сообщению приложен файл: 4747620.rar (48.7 Kb)

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для переноса данных из одного файла в другой

Страница 1 из 1
1

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