主页 / computer / 问题 / 1794273
Accepted
Rax
Asked: 2023-07-06 21:33:15 +0800 CST

VBA复制值并循环每行

  • 772

我有一系列列，其中大部分是空白单元格。我正在尝试复制这些单元格是否包含文本。为此，我编写了以下代码，该代码适用于第一行。如何对每一行重复此操作，直到最后使用的行？

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
vba

2 个回答

  1. Best Answer

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

    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
    • 0

  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
    • 0

相关问题