0

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

1 回答 1

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
于 2013-08-23T14:08:59.163 回答