Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/28.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 搜索列名并粘贴数据_Excel_Vba - Fatal编程技术网

Excel 搜索列名并粘贴数据

Excel 搜索列名并粘贴数据,excel,vba,Excel,Vba,我想通过使用列的名称搜索列,将公式粘贴到列中 我的列名是Date1。 我想在我的工作表中找到Date1,然后粘贴以下公式: IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5)) 这应该一直计算到Date1列的最后一行 请分享你在这方面的任何知识,这将非常有帮助 Sub FillFormula() Set wb = ActiveWo

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

我的列名是
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

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

为简单起见,假设第1行中有标题。现在我们需要找出Date1值所在的列。我们可以通过简单地在标题范围内循环检查值是否等于“Date1”来实现这一点。现在我们可以使用这些信息来构建最终范围

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

为简单起见,假设第1行中有标题。现在我们需要找出Date1值所在的列。我们可以通过简单地在标题范围内循环检查值是否等于“Date1”来实现这一点。现在我们可以使用这些信息来构建最终范围

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

请尝试下一个代码。它仍然基于O:O列计算最后一行。如果列“Date1”已经被覆盖,我可以很容易地修改代码以使用它:

Sub FillFormulaByHeader()
 Dim wb As Workbook, sh As Worksheet, lastRow As Long, celD As Range
 
    Set wb = ActiveWorkbook
    Set sh = wb.Worksheets("Sheet1")
    'Find the header ("Date1"):
    Set celD = sh.Range(sh.Range("A1"), sh.cells(, cells(1, Columns.count).End(xlToLeft).Column)).Find("Date1")
    If celD Is Nothing Then MsgBox "Nu such header could be found...": Exit Sub
    
    lastRow = sh.Range("O" & rows.count).End(xlUp).row 'it can be easily changed for column with Date1 header
    sh.Range(sh.cells(5, celD.Column), sh.cells(lastRow, celD.Column)).Formula = _
                "=IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))"
End Sub

请尝试下一个代码。它仍然基于O:O列计算最后一行。如果列“Date1”已经被覆盖,我可以很容易地修改代码以使用它:

Sub FillFormulaByHeader()
 Dim wb As Workbook, sh As Worksheet, lastRow As Long, celD As Range
 
    Set wb = ActiveWorkbook
    Set sh = wb.Worksheets("Sheet1")
    'Find the header ("Date1"):
    Set celD = sh.Range(sh.Range("A1"), sh.cells(, cells(1, Columns.count).End(xlToLeft).Column)).Find("Date1")
    If celD Is Nothing Then MsgBox "Nu such header could be found...": Exit Sub
    
    lastRow = sh.Range("O" & rows.count).End(xlUp).row 'it can be easily changed for column with Date1 header
    sh.Range(sh.cells(5, celD.Column), sh.cells(lastRow, celD.Column)).Formula = _
                "=IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))"
End Sub

如何将公式设置为该范围?不熟悉VBA,所以我不知道该怎么办。您可以在已建立的范围内循环,并为每行设置公式。我更新了答案如何将公式设置为该范围?不熟悉VBA,所以我不知道该怎么办。您可以在已建立的范围内循环,并为每行设置公式。我更新了我的答案“Date1”已经有记录了吗?代码是否应覆盖现有公式?否则,基于此列计算最后一行将是错误的…否,Date1为emptySo,最后一行应根据另一列内容计算。请检查我贴的代码。它根据O:O列计算最后一行,就像我之前的回答一样,因为该列包含在公式中……Date1是否已经有记录?代码是否应覆盖现有公式?否则,基于此列计算最后一行将是错误的…否,Date1为emptySo,最后一行应根据另一列内容计算。请检查我贴的代码。它根据O:O列计算最后一行,就像我之前的回答一样,因为这个列包含在公式中…@Rohini Baburaj我的代码没有解决你的问题吗?你有时间测试吗?@Rohini Baburaj我的代码没有解决你的问题吗?你有时间测试吗?