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

Автор Ninjatrasher, 24.11.2014, 15:50

« назад - далее »

Ninjatrasher

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

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

vikttur

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

   ЦИКЛ от 1 до 1000
         ЕСЛИ ячейка пустая ТОГДА
                 выход из процедуры
         ИНАЧЕ
                 копия значения
         КОНЕЦ ЕСЛИ
   КОНЕЦ ЦИКЛА
КОЕЦ ПРОЦЕДУРЫ

Вам осталось записать это операторами VBA :)
Если вопросы остались, то прошу дать ответ на встречные вопросы:
- сами что-то делали?
- размер исходных данных какой?
- копировать значения куда?
- файл-пример с Вашими попытками где?

Ninjatrasher

#2
Цитата: vikttur от 24.11.2014, 15:59
Вам осталось записать это операторами VBA :)
В этом и был вопрос) операторы VBA

vikttur

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

Ninjatrasher

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

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

#5
Цитата: vikttur от 24.11.2014, 16:05
Операторы 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

#6
извиняюсь, немного некорректно описываю задачу.
и так
входные данные
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 [МОДЕРАТОР]