如何让Excel VBA仅对UsedRange中K列非空行填充Q列数据？

你的原代码问题很明确：直接对整列Range("K:K")做非空判断时，只要K列里有任何一个非空单元格，就会触发给整个Q列赋值的操作，这就是为什么所有Q列都被填充了。下面给你几种实用的解决方案，按需选择：

方案1：逐行遍历（直观易调试） #

这种方法适合数据量不大的场景，逻辑清晰，新手也容易理解和修改：

Sub FillQForNonEmptyK()
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    Dim inputVal As Variant
    
    ' 指定目标工作表（把"Sheet1"改成你实际的工作表名）
    Set targetWs = ThisWorkbook.Sheets("Sheet1")
    ' 获取Input工作表B2单元格的值（对应你写的R2C2）
    inputVal = ThisWorkbook.Sheets("Input").Range("B2").Value
    ' 找到K列最后一行有数据的行号，避免遍历整列浪费资源
    lastRow = targetWs.Cells(targetWs.Rows.Count, "K").End(xlUp).Row
    
    ' 从第1行开始遍历（如果你的数据从第2行开始，改成currentRow = 2 To lastRow）
    For currentRow = 1 To lastRow
        ' 跳过K列是空单元格的行，这里加Trim是为了排除只有空格的情况
        If Trim(targetWs.Cells(currentRow, "K").Value) <> "" Then
            targetWs.Cells(currentRow, "Q").Value = inputVal
        End If
    Next currentRow
End Sub

方案2：用SpecialCells高效批量赋值（适合大数据量） #

如果你的数据行数很多，逐行遍历会比较慢，用SpecialCells直接定位所有非空单元格，一次性赋值效率会高很多：

Sub FillQForNonEmptyK_Efficient()
    Dim targetWs As Worksheet
    Dim nonEmptyKRng As Range
    Dim inputVal As Variant
    
    Set targetWs = ThisWorkbook.Sheets("Sheet1")
    inputVal = ThisWorkbook.Sheets("Input").Range("B2").Value
    
    ' 捕获K列所有非空常量单元格（如果要包含公式返回的非空值，把xlCellTypeConstants改成xlCellTypeFormulas）
    On Error Resume Next ' 防止K列全空时触发错误
    Set nonEmptyKRng = targetWs.Range("K:K").SpecialCells(xlCellTypeConstants)
    On Error GoTo 0 ' 恢复错误捕获
    
    ' 如果找到非空单元格，就给对应的Q列赋值（Offset(0,6)是因为Q列比K列靠右6列）
    If Not nonEmptyKRng Is Nothing Then
        nonEmptyKRng.Offset(0, 6).Value = inputVal
    End If
End Sub

额外小提示 #

• 确保Input工作表确实存在，不然代码会报错；
• 如果K列有公式返回的空文本（比如=""），SpecialCells会把它当成非空单元格，这种情况建议用方案1，并且判断条件改成Len(Trim(targetWs.Cells(currentRow, "K").Value)) > 0；
• 如果你不想用VBA，也可以直接在Q列输入公式=IF(TRIM(K1)<>"",Input!$B$2,"")，下拉填充后再选择性粘贴为值。

内容的提问来源于stack exchange，提问作者Fuster