如何使非连续范围的单元格对引用的每个单元格起作用

时间:2018-08-16 15:35:52

标签: excel vba excel-vba excel-2010

我有一个不连续的范围,并且我希望用户在范围内的每个单元格中写入的内容都显示在我制作的表格的一列中。在表的第一列中,当用户在一个指定的单元格中一直添加值直至18时,该表中每个生成的条目都有程序编号。我将范围内的每个单元格重命名为“ Space_ (一些数字)”。即使我已经写了三个指定的单元格,我的表也只向我显示了第一个指定单元格中的第一个值。

enter image description here

到目前为止,这是我的代码:

Sub test2()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer
Dim rng As Range

Set rng = ws.Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")


ws.Range("A13:A31,B13:B31").ClearContents

For i = 1 To 18

If Not IsEmpty("rng") Then
ws.Range("A12").Offset(1).Value = i
End If
Exit For
Next i

If Not IsEmpty("rng") Then
    ws.Range("B12").Offset(1).Value = rng.Value
End If

End Sub

3 个答案:

答案 0 :(得分:6)

这应该解决我在评论中提到的各种问题:

Sub test2()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Long
Dim rng As Range, r As Range

With ws
    Set rng = .Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")
    .Range("A13:B31").ClearContents
    For Each r In rng.Areas
        If Not IsEmpty(r) Then
            .Range("A13").Offset(i).Value = i + 1
            .Range("B13").Offset(i).Value = r.Value
            i = i + 1
        End If
    Next r
End With

End Sub

答案 1 :(得分:2)

这里有几点-与其尝试将所有命名范围放入Range中,不如将它们分别放在Array中并循环遍历-如果它们不是空白,则将值放在进入细胞。

您的.Offset总是在第12行下移1,因此这就是为什么您只看到一行数据的原因。

Sub test2()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Long, j As Long
Dim rngarray As Variant

rngarray = Array("Space_7", "Space_10", "Space_13", "Space_16", "Space_19", "Space_22", "Space_25", "Space_28", "Space_31", "Space_34", "Space_37", "Space_40", "Space_53", "Space_56", "Space_59", "Space_62", "Space_65", "Space_68")
j = 12

ws.Range("A13:B31").ClearContents

For i = 0 To UBound(rngarray)

    If ws.Range(rngarray(i)).Value <> "" Then
        ws.Range("A12").Offset(j - 11).Value = i + 1
        ws.Range("B12").Offset(j - 11).Value = ws.Range(rngarray(i)).Value
        j = j + 1
    End If

Next i

End Sub

答案 2 :(得分:0)

我将按照以下步骤进行:

Sub test2()

    Dim i As Integer
    Dim rng As Range, cell As Range

    With ThisWorkbook.Sheets("Sheet1")
        .Range("A13:A31,B13:B31").ClearContents

        Set rng = .Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")

        For Each cell In rng.SpecialCells(xlCellTypeConstants).Areas
            ws.Range("A12:B12").Offset(i).Value = Array(i + 1, cell(1, 1).Value)
            i = i + 1
        Next
    End With    
End Sub