Question

我在下面有以下代码，它的作用是从初始文档（源）收集的信息中创建另一个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

Answer 1

你只需要在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

根据源工作簿中的数据在新工作簿中设置值

1 个答案: