Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
vba цикл для заполнения шаблона из файла csv
 
#1
24.11.2014 16:04:37
Добрый день!
Задача стоит следующая: написать цикл, который проверят, если  в столбце С в ячейках С1,С2,С3 и т.д  есть значения, тогда копируем определенные значения, если значение ячейки пусто, тогда завершается скрипт.

Сам алгоритм я примерно представляю:
Код
начало процедуры

   ЦИКЛ от 1 до 1000
         ЕСЛИ ячейка пустая ТОГДА
                 выход из процедуры
         ИНАЧЕ
                 копия значения
         КОНЕЦ ЕСЛИ
   КОНЕЦ ЦИКЛА
КОЕЦ ПРОЦЕДУРЫ
Заранее спасибо.
 
 
 
#2
24.11.2014 16:06:08
UndeadNinjaTrasher, с Вас файл-пример согласно правил форума.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#3
24.11.2014 16:10:20
Без примера, по алгоритму
Код
For Each cl In Columns(3).Cells
    If cl = "" Then Exit Sub
    cl.Copy Destination:=cl.Offset(, 1)
Next
Изменено: Sanja - 24.11.2014 16:14:03
Согласие есть продукт при полном непротивлении сторон
 
 
 
#4
24.11.2014 16:47:32
Или так (Без примера, по алгоритму )

Код
Sub Proverka()
Dim Rng As Range, vl
Set Rng = ThisWorkbook.Sheets("Лист1").Range("C1:C1000")
For Each vl In Rng                     'ЦИКЛ от 1 до 1000   //.Range("C1:C1000")
  If Not IsEmpty(vl.Value) Then        'ЕСЛИ ячейка не пустая ТОГДА
    vl.Offset(0, 2).Value = vl.Value   'копия значения  столбец Е
  End If                               'КОНЕЦ ЕСЛИ
Next
Set Rng = Nothing: Set vl = Nothing    'Уничтожаем объекты
End Sub                                'КОнЕЦ ПРОЦЕДУРЫ
 
 
 
#5
24.11.2014 17:12:43
извиняюсь, немного некорректно описываю задачу.
и так
входные данные
1. фаил csv
2. шаблон statement.xlsx
Нужно заполнить фаил statemenet данными из файла csv и сохранить его под именем statemenet_датазаполнениядокумента.xlsx

Сейчас имею вот такой кусок кода:
Код
Sub Ведомость()
Dim Wb1 As Workbook, wb2 As Workbook, myData As Variant

Set Wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\Templates\statement.xlsx")

'заполняем шапку
Wb1.ActiveSheet.Range("C2").Copy wb2.Sheets1.Range("L5")
Wb1.ActiveSheet.Range("D2").Copy wb2.Sheets1.Range("L4")
myValue = InputBox("Введите дату")
 wb2.Sheets(1).Range("L3").Value = myValue
 
  ' Сохраняем фаил 
 wb2.SaveAs Filename:="\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\stamenets\stamenet_" & wb2.Sheet(1).Range("L3") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
 , CreateBackup:=False
End Sub
У меня затык в следующем, в файле csv каждый разное значение строчек, соответственно нужен цикл, который проверяет, кол-во  строк в файле csv и добавляет такое же кол-во строк в фаил statement.xlsx и заполняется их данными по следюущему алгоритму:
Код
диапазон значений столбца A в csv копируем в диапазон B файла xlsx 
 диапазон значений столбца F в csv копируем в диапазон C файла xlsx   
диапазон значений столбца I в csv копируем в диапазон D файла xlsx  
диапазон значений столбца G в csv копируем в диапазон F файла xlsx  
диапазон значений столбца H в csv копируем в диапазон G файла xlsx
 
 
 
#6
24.11.2014 20:16:50
Цитата
Сам алгоритм я примерно представляю
Ну да, представляете  :)  
http://forum.msexcel.ru/index.php/topic,10539.0.html

Вы изменили задание. Переименовать тему? На какое?
 
 
 
#7
25.11.2014 00:04:36
доделайте сами сохранение файла.
 
 
 
#8
25.11.2014 09:12:42
Цитата
vikttur пишет:  Вы изменили задание. Переименовать тему? На какое?
Написал сразу на два форума.
я изначально не корректно сформировал задание.

поменять можно на "vba цикл для заполнения шаблона из файла csv"
 
 
 
#9
25.11.2014 09:20:29
Цитата
B.Key пишет: доделайте сами сохранение файла.
вообще не понятно, что делает ваш макрос, можете написать какие либо пояснения.
Код
sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
sCon = sCon & FilePath & ";Extended Properties=""text;HDR=" & FieldName & ";FMT=Delimited"""
вот что это? ругается на этот параметр.
Изменено: UndeadNinjaTrasher - 25.11.2014 11:09:58
 
 
 
#10
25.11.2014 10:15:32
запускаем, выбираем файл csv, нужные данные в нужном месте.
-----------
Боюсь пояснять долго придется :)
 
 
 
#11
25.11.2014 10:28:01
Цитата
B.Key пишет: Боюсь пояснять долго придется


Вот такую штуку выдает.
И куда вставлять параметры копирования? после вашего макроса, перед завершением процедуры?
Изменено: UndeadNinjaTrasher - 25.11.2014 11:10:14
 
 
 
#12
25.11.2014 10:45:30
мне трудно сказать, что у Вас с Jet, по идее все должно работать, но если файлы находятся на сетевых ресурсах то не уверен.
--------
 
 
 
#13
25.11.2014 11:01:31
Цитата
B.Key пишет: по идее все должно работать, но если файлы находятся на сетевых ресурсах то не уверен
в этом то и весь смысл, что csv приходит пользователю по электронной почте, а шаблон, который statement на сетевой шаре, и потом после заполнения он должен сохраниться так же на сетевую шару в определенную папку.
Изменено: UndeadNinjaTrasher - 25.11.2014 11:10:25
 
 
 
#14
25.11.2014 11:27:06
файл csv должен находдиться на физическом диске
 
 
 
#15
25.11.2014 12:08:16
Цитата
B.Key пишет: что у Вас с Jet
Боюсь ошибиться, но если ошибусь, может добрые люди поправят... помнится мне, вроде эта штука по умолчанию устанавливается с Access... поэтому если офис установлен без  Access - то эту штуковину (Jet) надо как-то дополнительно доустановить (или где-то включить)...

ТС, поэтому если у юзера, кому вы посылаете файл для заполнения... то - что я написала выше... вобщем есть вероятность (что в этом проблема)... даже если выполнено условие поста№14... это только гипотеза (я с бд не на ты - пока нет необходимости)
Изменено: JeyCi - 25.11.2014 12:12:11
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#16
25.11.2014 12:20:02
Цитата
B.Key пишет: файл csv должен находдиться на физическом диске
все равно не получается. решил делать по методу предложенному TSN , но выдало ошибку

вот кусок кода


Код
 Sub ведомость()

Dim Wb1 As Workbook, wb2 As Workbook, myData As Variant, Rng As Range, vl

Set Rng = ActiveWorkbook.ActiveSheets.Range("C1:C1000")
Set Wb1 = ActiveWorkbook
Set wb2 = Workbooks.Open("\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\Templates\statement.xlsx")

'çàïîëíÿåì øàïêó

 Wb1.ActiveSheet.Range("C2").Copy Destination:=wb2.Sheets(1).Range("L5")
Wb1.ActiveSheet.Range("D2").Copy Destination:=wb2.Sheets(1).Range("L4")

myValue = InputBox("введите дату")
 wb2.Sheets(1).Range("L3").Value = myValue
 
 wb2.Sheets(1).Range("L5").Borders.LineStyle = xlContinuous
 wb2.Sheets(1).Range("L4").Borders.LineStyle = xlContinuous
 
 ' öèêë êîïèðîâàíèÿ äàííûõ
  
 For Each vl In Rng
 
 If Not IsEmpty(vl.Value) Then
 
 Wb1.ActiveSheet.Range("F2").Copy Destination:=wb2.sheet1.Range("C8")
 
 End If
 
 Next
  
 ' сохраняем фаил 
 wb2.SaveAs Filename:="\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\MX1\stamenet" & wb2.Sheet(1).Range("L3") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
 , CreateBackup:=False

End Sub
ругается на Set Rng = ActiveWorkbook.ActiveSheets.Range("C1:C1000" ;)
что не так я написал?
 
 
 
#17
25.11.2014 12:22:42
Копируйте код при русской раскладке клавиатуры. Столько пустых строк в коде не нужно (убрал лишние).
 
 
 
#18
25.11.2014 12:30:10
извините, в следующий раз буду копировать при русской раскладке.
 
 
 
#19
25.11.2014 12:35:31
Код
Set Rng = ActiveWorkbook.ActiveSheet.Range("C1:C1000")

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#20
25.11.2014 12:43:16
спасибо, не углядел.
 
 
 
#21
25.11.2014 13:45:01
сейчас вот такой цикл
Код
 ' цикл копирования данных 
   For Each vl In Rng
       If Not IsEmpty(vl.Value) Then
          Wb1.ActiveSheet.Range("F2").Copy Destination:=wb2.Sheets(1).Range("C8") 
       End If 
    Next 

 ' сохраняем документ 
    wb2.SaveAs Filename:="\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\MX1\stamenet_" & wb2.Sheets(1).Range("L3") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
но он не правильный, так как копируется лишь одно значение F2. не понимаю как указать, что бы проверился весь диапазон C1:C1000 и если значение не пустые, то он их бы копировал на вторую книгу
 
 
 
#22
25.11.2014 13:48:35
Код
' цикл копирования данных
cnt=0
 For Each vl In Rng
 If Not IsEmpty(vl.Value) Then
 Wb1.ActiveSheet.Range("F2").offset(cnt).Copy Destination:=wb2.Sheets(1).Range("C8")
cnt=cnt+1
 End If
 Next vl
 ' сохраняем документ
 wb2.SaveAs Filename:="\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\MX1\stamenet_" & wb2.Sheets(1).Range("L3") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Внёс смещение по строке от указанной ячейки.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#23
25.11.2014 13:55:00
UndeadNinjaTrasher, посмотрите свой код в сообщении 21. Стал хуже того, который Вы выложили (был с пустыми строками)?
 
 
 
#24
25.11.2014 13:59:40
Цитата
vikttur пишет:
UndeadNinjaTrasher , посмотрите свой код в сообщении 21. Стал хуже того, который Вы выложили (с пустыми строками)?
не очень понял вопрос. Хуже не стал, стал лучше, более компактный.
 
 
 
#25
25.11.2014 14:03:44
Цитата
JayBhagavan пишет:
к
все равно чушь какая то получается.

в исходном фаиле CSV , каждый раз кол-во значений в столбце F разное, нужно что бы эти значения копировались в  фаил в statmenet.xls столбец С и добавлялась строчка, если значений в столбце F файла CSV  больше чем одно.
Изменено: UndeadNinjaTrasher - 25.11.2014 14:05:51
 
 
 
#26
25.11.2014 15:28:08
еще пойти другим путем
1. вычисляю сколько заполненных ячеек в файле csv
2. добавить это кол-во строк в фаил statemenet

вот какой код


Код
Sub Макрос1()
Dim Wb1 As Workbook, wb2 As Workbook, iLastRow As Long


Set Wb1 = ActiveWorkbook

Set wb2 = Workbooks.Open("\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\Templates\statement.xlsx")

lr = 0 
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
ir = iLastRow - 1
wb2.Sheets(1).Rows(8).Select
Selection.InsertRowsBelow (ir)

End Sub
Но все равно не выходиться, ругается на Selection.InsertRowsBelow (ir), можно ли как нибудь передать значение переменной ir в функцию Selection.InsertRowsBelow? или я вообще не правильно делают?
 
 
 
#27
25.11.2014 15:40:49
Код
selection.entirerow.Insert Shift:=xlDown

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#28
25.11.2014 15:46:50
Цитата
JayBhagavan пишет:
Код ?
эм... спасибо, а можно как нибудь добавить больше чем по одной строке?


Код
 Selection.offset(5,0).EntireRow.Insert
не работает почему то
Изменено: UndeadNinjaTrasher - 25.11.2014 15:49:24
 
 
 
#29
25.11.2014 15:54:00
Код
[A6:A8].entirerow.Insert Shift:=xlDown
Смелее экспериментируйте. (первый раз вставляю более одной строки кодом  ;)  )
Изменено: JayBhagavan - 25.11.2014 15:54:13

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#30
25.11.2014 15:57:51
Цитата
JayBhagavan пишет:
Смелее экспериментируйте. (первый раз вставляю более одной строки кодом )
эм... так видимо я не очень правильно объяснил, можно указать количество строк, какое я хочу вставить, а не указывать диапазон, за количество вставляемых строк, у меня отвечает переменная ir, могу ли передать эту переменную в функцию entirerow.Insert? что бы вставлялось число, которое содержится в этой переменной? или нет?

за строчки кодов большое спасибо.
 
 
 
Страницы: 1 2 След.
Наверх