简体   繁体   English

自动填充公式向下列但跳过已填充的单元格

[英]Auto fill a formula down a column but skipping already populated cells

After numerous failed attempts I am really hoping someone can with my problem.经过无数次失败的尝试,我真的希望有人能解决我的问题。 It theory what I am trying to do sounds easy enough but I have spent hours on it today with no success.理论上我想做的事情听起来很容易,但我今天花了几个小时没有成功。

I have tried all the possible solutions from this thread but to no avail: Excel vba Autofill only empty cells我已经尝试了该线程中所有可能的解决方案,但无济于事: Excel vba Autofill only empty cells

Also looked here : https://www.mrexcel.com/board/threads/macro-to-copy-cell-value-down-until-next-non-blank-cell.660608/还看了这里: https ://www.mrexcel.com/board/threads/macro-to-copy-cell-value-down-until-next-non-blank-cell.660608/

I am looking to autofill a formula down a column(a vlookup from another sheet) but if there is already populated cells then to skip and continue the formula in the next available blank cell.我希望在列中自动填充公式(来自另一张表的 vlookup),但如果已经填充了单元格,则跳过并继续下一个可用空白单元格中的公式。 For example, in rows A2:A10, row A5 has a value in it, so the formula gets into in A2, then fills to A4, then skips A5, then continues in A6 to A10.例如,在 A2:A10 行中,A5 行中有一个值,因此公式进入 A2,然后填充到 A4,然后跳过 A5,然后在 A6 中继续到 A10。

This below code works the first time you use it but then on the second run it debugs with a "Run-time error '1004' - No cells were found".下面的代码在您第一次使用它时工作,但在第二次运行时它会调试“运行时错误'1004' - 未找到单元格”。 I noticed it it putting the formula into the first cell (B2) and then debugging out.我注意到它将公式放入第一个单元格(B2)然后调试出来。

Sub FillDownFormulaOnlyBlankCells()
Dim wb As Workbook
Dim ws1, ws2 As Worksheet
Dim rDest As Range
Set wb = ThisWorkbook

Set ws1 = Sheets("Copy From")
Set ws2 = Sheets("Copy To")

ws2.Range("A1").Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"

Set rDest = Intersect(ActiveSheet.UsedRange, Range("B2:B300").Cells.SpecialCells(xlCellTypeBlanks))

ws2.Range("B2").Copy rDest

End Sub

Please, try the next code:请尝试下一个代码:

Sub FillDownFormulaOnlyBlankCells()
 Dim wb As Workbook, ws1 As Worksheet, rngBlanc As Range

 Set wb = ThisWorkbook
 Set ws1 = wb.Sheets("Copy From")

 On Error Resume Next
  Set rngBlanc = ws1.Range("B2:B" & ws1.rows.count.End(xlUp).row).SpecialCells(xlCellTypeBlanks)
 On Error GoTo 0
 
 If Not rngBlanc Is Nothing Then
        rngBlanc.Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"
 Else
    MsgBox "No blanc rows exist in B:B column..."
 End If
End Sub

After running it once and do not create any empty cell, of course there will not be any blanc cells, anymore , at a second run...运行一次并且不创建任何空单元格后,当然不会再有任何空白单元格,在第二次运行时......

Thanks to FaneDuru for his suggestion but I actually came up with an alternative solution to my problem which I though I would post as it might help others with a similar issue.感谢 FaneDuru 的建议,但我实际上想出了一个替代解决方案来解决我的问题,尽管我会发布它,因为它可能会帮助其他有类似问题的人。

On a separate sheet, I created 3 columns, first column is names I already have, 2nd column are the new names and the 3rd column is there to combine the first 2 columns together, then use this code to combine first 2 columns :在另一张纸上,我创建了 3 列,第一列是我已有的名称,第二列是新名称,第三列用于将前 2 列组合在一起,然后使用此代码组合前 2 列:

Sub MergeColumns()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim LastRow As Long, i As Long

Set ws1 = Sheets("Your Sheet Name")

LastRow = ws1.Range("F" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If ws1.Range("G" & i) <> "" Then
    ws1.Range("I" & i) = ws1.Range("H" & i).Text & "" & ws1.Range("G" & i).Text
    Else: ws1.Range("I" & i) = ws1.Range("H" & i)

End If
Next i

End Sub

Obviously changing the sheet name and columns letter to suit your requirements.显然更改工作表名称和列字母以满足您的要求。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM