☰

VBA 复制值并循环每一行

tag-icon • tag-icon vba macros
VBA 复制值并循环每一行

我有一列，其中大部分都是空白单元格。我想复制其中任何一个单元格是否包含文本。为此，我编写了以下代码，该代码在第一行运行良好。如何对每一行重复此操作直到最后一行？

Dim SrchRng As Range, cel As Range
Set SrchRng = Sheet1.Range("BI2:CZ2")
        For Each cel In SrchRng
        If cel.Value <> "" Then
        Sheet1.Range("AH2").Value = cel.Value
    End If
Next cel

答案1

您几乎做对了所有事情 - 只缺少一个细微差别：写入目标单元格后，您需要将此单元格向右或向下移动。例如，可以像这样完成：

Sub copyNonEmptyCells()
Dim SrchRng As Range, cel As Range, targetCel As Range
    Set SrchRng = Sheet1.Range("BI2:CZ2")
    Set targetCel = Sheet1.Range("AH2")
    For Each cel In SrchRng.Cells
        If cel.Value <> "" Then
            targetCel.Value = cel.Value
            Set targetCel = targetCel.Offset(0, 1) ' or (1,0)
        End If
    Next cel
End Sub

如果您想将范围内每一行的所有非空值连接到一个单元格中，正如您在评论中所指出的那样，宏代码不会变得复杂得多：

Sub joinNonEmptyCells()
Dim SrchRng As Range, cel As Range, targetCel As Range, oSingleRow As Range
    Set SrchRng = Sheet1.Range("BI2:CZ100")
    Set targetCel = Sheet1.Range("AH2")
    targetCel.Value = ""
    For Each oSingleRow In SrchRng.Rows
        For Each cel In oSingleRow.Cells
            If cel.Value <> "" Then
                targetCel.Value = targetCel.Value & " " & cel.Value
            End If
        Next cel
        targetCel.Value = Trim(targetCel.Text)
        Set targetCel = targetCel.Offset(1, 0)
        targetCel.Value = ""
    Next oSingleRow
End Sub

答案2

尝试以下代码。它首先找到工作表上的最后一行。然后，循环遍历行（从第 2 行到最后一行），并在 AH 中设置找到的值（如果找到）。

Public Sub Test()

Dim SrchRng As Range, cel As Range
Dim lastRow As Long
'Get the last row
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

    For x = 2 To lastRow 'Loop the rows
        Set SrchRng = Sheet1.Range("BI" & x & ":CZ" & x)
        For Each cel In SrchRng 'Loop through each row
            If cel.Value <> "" Then
                Sheet1.Range("AH" & x).Value = cel.Value
            End If
        Next cel

    Next x
End Sub

相关内容