Задайте значение в новой книге в зависимости от данных в исходной книге

У меня есть следующий код ниже и что он делает, это создать другой документ Excel из информации, собранной из исходного документа (источника). Итак, теперь я хочу создать инструкцию, которая будет проверять меня:

  • Если столбцы E и F имеют значения, то я хочу принять значение F
  • Если E пусто, я хочу принять значение F
  • Если F пусто, я хочу взять значение E

Я хочу, чтобы последнее значение отображалось только в столбце K в новой книге.

Имейте в виду, что столбец E и F находится в исходном документе.

 Sub test() Dim ws As Worksheet Dim rngData As Range Dim DataCell As Range Dim arrResults() As Variant Dim ResultIndex As Long Dim strFolderPath As String Set ws = Sheets("Sheet1") Set rngData = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp)) If rngData.Row < 2 Then Exit Sub 'No data ReDim arrResults(1 To rngData.Rows.Count, 1 To 11) strFolderPath = ActiveWorkbook.Path & Application.PathSeparator For Each DataCell In rngData.Cells ResultIndex = ResultIndex + 1 Select Case (Len(ws.Cells(DataCell.Row, "B").Text) > 0) Case True: arrResults(ResultIndex, 1) = "" & ws.Cells(DataCell.Row, "B").Text & "" Case Else: arrResults(ResultIndex, 1) = "" & ws.Cells(DataCell.Row, "A").Text & "" End Select arrResults(ResultIndex, 2) = "" & ws.Cells(DataCell.Row, "B").Text & "" arrResults(ResultIndex, 3) = "animals/type/" & DataCell.Text & "/option/an_" & DataCell.Text & "_co.png" arrResults(ResultIndex, 4) = "animals/" & DataCell.Text & "/option/an_" & DataCell.Text & "_co2.png" arrResults(ResultIndex, 5) = "animals/" & DataCell.Text & "/shade/an_" & DataCell.Text & "_shade.png" arrResults(ResultIndex, 6) = "animals/" & DataCell.Text & "/shade/an_" & DataCell.Text & "_shade2.png" arrResults(ResultIndex, 7) = "animals/" & DataCell.Text & "/shade/an_" & DataCell.Text & "_shade.png" arrResults(ResultIndex, 8) = "animals/" & DataCell.Text & "/shade/an_" & DataCell.Text & "_shade2.png" arrResults(ResultIndex, 9) = "" & ws.Cells(DataCell.Row, "C").Text & "" arrResults(ResultIndex, 10) = "" & ws.Cells(DataCell.Row, "D").Text & "" arrResults(ResultIndex, 11) = "" & ws.Cells(DataCell.Row, "E").Text & "" Next DataCell 'Add a new sheet With Sheets.Add Sheets("Sheet2").Rows(1).Copy .Range("A1") .Range("A2").Resize(ResultIndex, UBound(arrResults, 2)).Value = arrResults '.UsedRange.EntireRow.AutoFit 'Uncomment this line if desired 'The .Move will move this sheet to its own workook .Move 'Save the workbook, turning off DisplayAlerts will suppress prompt to override existing file Application.DisplayAlerts = False ActiveWorkbook.SaveAs strFolderPath & "destin.xls", xlExcel8 Application.DisplayAlerts = True End With Set ws = Nothing Set rngData = Nothing Set DataCell = Nothing Erase arrResults End Sub 

Вам просто нужна простая формула в столбце K.

 =IF(F2="", E2, F2) 
  • Если значения F и E имеют значения, F не будет пустым, и результат будет равен F.
  • Если F пуст, результатом будет E.
  • Если F имеет значение, значение будет равно F.
  • Если оба они пусты, значение будет пустым.

Вы можете запрограммировать эту формулу. Вот пример, который вы можете включить в свой код:

 Sub FormulaInColumn() Dim ws As Worksheet Dim wb As Workbook Dim lastRow As Long Set wb = ActiveWorkbook Set ws = wb.Sheets("Sheet1") lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row ws.Range("K2").Formula = "=IF(F2="""", E2, F2)" ws.Range("K2").Copy ws.Range("K3:K" & lastRow) End Sub 
Interesting Posts

Помещенная последовательность подстроки в ячейке для целой строки

Падение данных в стандартной форме excel

Объединение нескольких таблиц Excel в сводный лист

Использование условного форматирования для выделения строки, если дата в столбце F равна сегодняшней дате

Метод существует и не распознается … "Sub или функция не определена vba"

Как я могу использовать функцию тренда Excel (2007) в Access?

Автоматический фильтр POI

Получение данных с веб-сайта с паролем

Невозможно использовать свойство excel столбца

Используя Excel и VBA, я хочу автозаполнять календарь с датой начала и окончания

Объединение ненулевых значений из нескольких столбцов в один в Excel

Оптимизация Excel VBA – Транспонирование данных

перебирать записи в excel и обновлять определенные строки в базе данных mysql со значениями из файла excel в php

Импорт данных Excel в SQL с помощью VB6

Макрос Excel, который использует изображения, имеет проблемы с циклом

Давайте будем гением компьютера.