vba скрипт проверки наличия значений в ячейки

[Ninjatrasher]

Добрый день!
Задача стоит следующая: написать цикл, который проверят, если  в столбце С в ячейках С1,С2,С3 и т.д  есть значения, тогда копируем определенные значения, если значение ячейки пусто, тогда завершается скрипт.

Заранее спасибо.

[vikttur]

Код Выделить Развернуть

начало процедуры

   ЦИКЛ от 1 до 1000
         ЕСЛИ ячейка пустая ТОГДА
                 выход из процедуры
         ИНАЧЕ
                 копия значения
         КОНЕЦ ЕСЛИ
   КОНЕЦ ЦИКЛА
КОЕЦ ПРОЦЕДУРЫ
Вам осталось записать это операторами VBA
Если вопросы остались, то прошу дать ответ на встречные вопросы:
- сами что-то делали?
- размер исходных данных какой?
- копировать значения куда?
- файл-пример с Вашими попытками где?

[Ninjatrasher]

Вам осталось записать это операторами VBA

В этом и был вопрос) операторы VBA

[vikttur]

Операторы VBA, необходимые для решения:
Sub-End Sub
For-Next
If-Then-Else-End If
Copy-Paste или обработка в массиве

[Ninjatrasher]

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

Код Выделить Развернуть


Sub Mx1()
Dim Wb1 As Workbook, wb2 As Workbook, myData As Variant

'copy from ThisWorkbook

Set Wb1 = ActiveWorkbook

'To This

Set wb2 = Workbooks.Open("\\s-pkv01-dc01.ylrus.com\PKV01-Workgroups\FUJIFILM\Forms\Templates\MX1.xlsx")

'Copy Document Number

' Wb1.ActiveSheet.Range("C2").Copy wb2.Sheets(1).Range("H18:L18")
wb2.Sheets(1).Range("H18:L18") = Wb1.ActiveSheet.Range("D2").Value & "/" & Wb1.ActiveSheet.Range("C2").Value
wb2.Sheets(1).Range("H18:L18").Font.Size = 8
wb2.Sheets(1).Range("H18:L18").Columns.AutoFit
' Copy Description

Wb1.ActiveSheet.Range("F2:F31").copy wb2.Sheets(1).Range("D29:D58")
Wb1.ActiveSheet.Range("F32:F71").copy wb2.Sheets(2).Range("D7:D46")
wb2.Sheets(1).Range("D29:D58").Borders.LineStyle = xlContinuous
wb2.Sheets(2).Range("D7:D46").Borders.LineStyle = xlContinuous
wb2.Sheets(1).Range("D29:D58").Font.Size = 6
wb2.Sheets(2).Range("D7:D46").Font.Size = 6
wb2.Sheets(1).Range("D29:D58").Columns.AutoFit
wb2.Sheets(2).Range("D7:D46").Columns.AutoFit

' Copy Code

Wb1.ActiveSheet.Range("E2:E31").copy wb2.Sheets(1).Range("E29:E58")
Wb1.ActiveSheet.Range("E32:E71").copy wb2.Sheets(2).Range("G7:G46")
wb2.Sheets(1).Range("E29:E58").Borders.LineStyle = xlContinuous
wb2.Sheets(2).Range("G7:G46").Borders.LineStyle = xlContinuous
wb2.Sheets(1).Range("E29:E58").Font.Size = 8
wb2.Sheets(2).Range("G7:G46").Font.Size = 8
wb2.Sheets(1).Range("E29:E58").Columns.AutoFit
wb2.Sheets(2).Range("G7:G46").Columns.AutoFit

' Copy Q-ty

Wb1.ActiveSheet.Range("I2:I31").copy wb2.Sheets(1).Range("L29:L58")
Wb1.ActiveSheet.Range("I32:I71").copy wb2.Sheets(2).Range("N7:N46")
wb2.Sheets(1).Range("L29:L58").Borders.LineStyle = xlContinuous
wb2.Sheets(2).Range("N7:N46").Borders.LineStyle = xlContinuous
wb2.Sheets(1).Range("L29:L58").Font.Size = 8
wb2.Sheets(2).Range("N7:N46").Font.Size = 8
'wb2.Sheets(1).Range("L29:L58").Columns.AutoFit
'wb2.Sheets(2).Range("N7:N46").Columns.AutoFit

' Create Data

myValue = InputBox("Введите дату составления документа, формат ввода (день.месяц.год)")
wb2.Sheets(1).Range("O18:Q18").Value = myValue

' Save New MX1 to folder

wb2.SaveAs Filename:="\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\MX1\MX1_" & Wb1.ActiveSheet.Range("D2").Value & "_" & Wb1.ActiveSheet.Range("C2").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False


' Close MX1

' wb2.Close

End Sub

[\code]



[Ninjatrasher]

Операторы VBA, необходимые для решения:...

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

Код Выделить Развернуть


For Each cl In Wb1.Columns(3).Cells
    If cl = "" Then Exit Sub


  Wb1.ActiveSheet.Range("C2").Copy wb2.Sheets(1).Range("H18:L18")
wb2.Sheets(1).Range("H18:L18") = Wb1.ActiveSheet.Range("D2").Value & "/" & Wb1.ActiveSheet.Range("C2").Value
wb2.Sheets(1).Range("H18:L18").Font.Size = 8
wb2.Sheets(1).Range("H18:L18").Columns.AutoFit
' Copy Description

Wb1.ActiveSheet.Range("F2:F31").copy wb2.Sheets(1).Range("D29:D58")
Wb1.ActiveSheet.Range("F32:F71").copy wb2.Sheets(2).Range("D7:D46")
wb2.Sheets(1).Range("D29:D58").Borders.LineStyle = xlContinuous
wb2.Sheets(2).Range("D7:D46").Borders.LineStyle = xlContinuous
wb2.Sheets(1).Range("D29:D58").Font.Size = 6
wb2.Sheets(2).Range("D7:D46").Font.Size = 6
wb2.Sheets(1).Range("D29:D58").Columns.AutoFit
wb2.Sheets(2).Range("D7:D46").Columns.AutoFit

' Copy Code

Wb1.ActiveSheet.Range("E2:E31").copy wb2.Sheets(1).Range("E29:E58")
Wb1.ActiveSheet.Range("E32:E71").copy wb2.Sheets(2).Range("G7:G46")
wb2.Sheets(1).Range("E29:E58").Borders.LineStyle = xlContinuous
wb2.Sheets(2).Range("G7:G46").Borders.LineStyle = xlContinuous
wb2.Sheets(1).Range("E29:E58").Font.Size = 8
wb2.Sheets(2).Range("G7:G46").Font.Size = 8
wb2.Sheets(1).Range("E29:E58").Columns.AutoFit
wb2.Sheets(2).Range("G7:G46").Columns.AutoFit

' Copy Q-ty

Wb1.ActiveSheet.Range("I2:I31").copy wb2.Sheets(1).Range("L29:L58")
Wb1.ActiveSheet.Range("I32:I71").copy wb2.Sheets(2).Range("N7:N46")
wb2.Sheets(1).Range("L29:L58").Borders.LineStyle = xlContinuous
wb2.Sheets(2).Range("N7:N46").Borders.LineStyle = xlContinuous
wb2.Sheets(1).Range("L29:L58").Font.Size = 8
wb2.Sheets(2).Range("N7:N46").Font.Size = 8
'wb2.Sheets(1).Range("L29:L58").Columns.AutoFit
'wb2.Sheets(2).Range("N7:N46").Columns.AutoFit

' Create Data

myValue = InputBox("Введите дату составления документа, формат ввода (день.месяц.год)")
wb2.Sheets(1).Range("O18:Q18").Value = myValue

' Save New MX1 to folder

wb2.SaveAs Filename:="\\ylrus.com\files\PKV01-Workgroups\FUJIFILM\Forms\MX1\MX1_" & Wb1.ActiveSheet.Range("D2").Value & "_" & Wb1.ActiveSheet.Range("C2").Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False


' Close MX1

' wb2.Close

End Sub


[Ninjatrasher]

извиняюсь, немного некорректно описываю задачу.
и так
входные данные
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

Тема обсуждается параллельно (автору - Вы сами должны давать такие ссылки): http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=61640&TITLE_SEO=61640-vba-skript-proverki-nalichiya-znacheniy-v-yacheyki [МОДЕРАТОР]