首页 > 解决方案 > 搜索列名并粘贴数据

问题描述

我想通过使用名称搜索列来将公式粘贴到列中。

我的专栏名称是Date1。我想Date1在我的工作表中找到并粘贴以下公式:

IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))

这应该计算到Date1列的最后一行。

请分享您对此的任何知识,这将非常有帮助。

Sub FillFormula()
 Set wb = ActiveWorkbook
 Dim sh As Worksheet, lastRow As Long
 
    Set sh = wb.Worksheets("Sheet1")
    lastRow = sh.Range("O" & Rows.count).End(xlUp).Row 'chosen O:O column, being involved in the formula...
    sh.Range("AC5:AC" & lastRow).Formula = "=IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))"
 
    lastRow2 = sh.Range("R" & Rows.count).End(xlUp).Row
    sh.Range("AD5:AD" & lastRow).Formula = "=IF(ISBLANK(B5),"""",IF(ISBLANK(R5)=TRUE,""Missing RSD"",TODAY()-R5))"
 
End Sub

这是我当前使用的代码,它可以正常工作,但我的列可能会改变,所以我不想使用列字符,而是使用列名将数据粘贴到正确的列中。

标签: excelvba

解决方案


为简单起见,假设您在第 1 行中有标题。我们现在需要找出我们的 Date1 值在哪一列。我们可以通过简单地遍历 Header Range 检查值是否等于“Date1”来做到这一点。现在我们可以使用这些信息来构建最终的 Range。

Sub FindDate1()

    Dim c As Range
    Dim date1Column as integer
    Dim finalRange As Range

    For Each c In Range("A1:Z1")
        If c.Value = "Date1" Then
            date1Column = c.Column
            Exit For
        End If
    Next c

    If date1Column = 0 Then
        'in case "Date1" was not found
        Exit Sub 
    Else
        Set finalRange = Range(Cells(2, date1Column), Cells(2, date1Column).End(xlDown))
        For Each c In finalRange
            c.Formula = "=IF(ISBLANK(B" & c.Row & "),"""",IF(ISBLANK(O" & c.Row & ")=TRUE,""Missing PSD"",TODAY()-O" & c.Row & "))"
        Next c
    End If
End Sub

推荐阅读