VBA如果单元格包含值然后复制它

Question

您好，正在寻找一个简单的 VBA 如果单元格包含值，则将检查 D 列从第 10 行到第 150 行，然后将该单元格复制到 D9 并打印活动表 如果单元格为空，则什么也不做

我从 1 到 150 获取数据，需要打印标签我目前正在做一买一复制粘贴和打印 因此，如果有人可以提供帮助，我将不胜感激

Answer 1

我几乎是 VBA 的第一步，我有一个类似的案例，所以我会尽力帮助你解决一些你可以使用的东西。

我不明白你所说的“打印活动表”是什么意思，但我想我会让你自己搜索那部分，这里有一点可以帮助你入门：

Sub CheckIfCellContainsValue()
 Dim index As Integer, NumberOfRows As Integer, ActualCellValue As Variant
  NumberOfRows = Range("D10:D150").Rows.Count
  For index = 10 To NumberOfRows + 9
    ActualCellValue = Range("D" & index).Value
    Debug.Print ActualCellValue
    If IsEmpty(ActualCellValue) Then
     ' Do nothing
    Else
     Range("D9").Value = ActualCellValue
     ' Insert your do print activ sheet code here.
    End If
    Set ActualCellValue = Nothing
  Next
End Sub

我知道这看起来很复杂，我欢迎社区提供任何意见以降低我的代码复杂度。

干杯，

Answer 2

如果不是空白（且不是错误值）则复制

Option Explicit

Sub PrintForNonBlankCells()
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    ' Instead of the previous line, I prefer something like:
    'Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim cCell As Range: Set cCell = ws.Range("D9") ' Criteria Cell
    
    Dim lrg As Range: Set lrg = ws.Range("D10:D150") ' Lookup Range
    ' To make the previous line dynamic instead, you could e.g. do:
    'Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp)
    'Dim lrg As Range: Set lrg = ws.Range("D10:D" & LastRow)
    
    Dim lCell As Range ' Lookup Cell
    For Each lCell In lrg.Cells
        If Not IsError(lCell) Then ' exclude error values
            If Len(lCell.Value) > 0 Then ' exclude blanks
                cCell.Value = lCell.Value
                ws.Calculate ' may not be necessary
                ws.PrintOut ' add the desired parameters (no parentheses)
            End If
        End If
    Next lCell

End Sub