比较活动单元格地址与数组内容

huangapple go评论73阅读模式
英文:

Comparing Active Cell Address To Contents of Array

问题

我正在尝试循环遍历给定范围内的值,并将与某些条件匹配的单元格的地址写入数组(为了演示目的,我只是寻找值为"somevalue"的单元格)。然后,我希望再次循环遍历相同的范围,并将活动单元格的地址与写入数组的地址列表进行比较。如果有匹配,则我希望将活动单元格与其下方的两个单元格合并。就是这样。简化的代码如下:

代码运行正常,并将正确的地址记录到数组中。但是在第二个循环的顶部的这一行"If cSched.Address = aBands(x, 1) Then",我遇到以下错误:运行时错误'9':下标超出范围。欢迎提出任何建议!

Sub stackoverflowtest2()

Dim shtSched As Worksheet 'the tab where schedule blocks will be created
Dim rSched As Range 'range of schedule
Dim cSched As Range 'a single cell on Schedule tab
Dim aBands As Variant 'array containing addresses of band locations on schedule
Dim BandCounter As Integer 'counter for number of bands written
Dim x As Integer 'counter
Dim msg As String 'for testing

'Setup
    Set shtSched = ActiveWorkbook.ActiveSheet
    Set rSched = Range(shtSched.Range("Start"), shtSched.Range("Start").Offset(122, 6))

'Loop 1: work through cells, record address for matches
    BandCounter = 1
    For Each cSched In rSched
        If cSched.Value = "somevalue" Then
            ReDim aBands(1 To BandCounter, 1)
            aBands(BandCounter, 1) = cSched.Address
            msg = msg & aBands(BandCounter, 1) & vbNewLine 'for testing
            BandCounter = BandCounter + 1
        End If
    Next

'Show all matching addresses, for testing
    MsgBox msg

'Loop 2: work through cells 2nd time, if address is in array then merge cells
    For Each cSched In rSched
        For x = 1 To BandCounter
            If cSched.Address = aBands(x, 1) Then
                MsgBox "We have a match!" 'for testing
                Range(cSched, cSched.Offset(2, 0)).MergeCells = True
                Exit For
            End If
        Next x
    Next
    
End Sub
英文:

I am trying to loop through the values in a given range and write to an array the address of any cell that matches some criteria (for demo purposes, I am just looking for cells whose value is "somevalue"). I then want to take a second loop through the same range and compare the address of the active cell to the list of addresses written to the array. If there is a match then I want to merge the active cell with the 2 cells below it. That's it. Simplified code is below.

The code works fine and is recording the correct addresses to the array. But at the top of the second loop at this line "If cSched.Address = aBands(x, 1) Then", I am getting the following error: Run-time error '9': Subscript out of range. All suggestions appreciated!

Sub stackoverflowtest2()

Dim shtSched As Worksheet 'the tab where schedule blocks will be created
Dim rSched As Range 'range of schedule
Dim cSched As Range 'a single cell on Schedule tab
Dim aBands As Variant 'array containing addresses of band locations on schedule
Dim BandCounter As Integer 'counter for number of bands written
Dim x As Integer 'counter
Dim msg As String 'for testing

'Setup
    Set shtSched = ActiveWorkbook.ActiveSheet
    Set rSched = Range(shtSched.Range("Start"), shtSched.Range("Start").Offset(122, 6))

'Loop 1: work through cells, record address for matches
    BandCounter = 1
    For Each cSched In rSched
        If cSched.Value = "somevalue" Then
            ReDim aBands(1 To BandCounter, 1)
            aBands(BandCounter, 1) = cSched.Address
            msg = msg & aBands(BandCounter, 1) & vbNewLine 'for testing
            BandCounter = BandCounter + 1
        End If
    Next

'Show all matching addresses, for testing
    MsgBox msg

'Loop 2: work through cells 2nd time, if address is in array then merge cells
    For Each cSched In rSched
        For x = 1 To BandCounter
            If cSched.Address = aBands(x, 1) Then
                MsgBox "We have a match!" 'for testing
                Range(cSched, cSched.Offset(2, 0)).MergeCells = True
                Exit For
            End If
        Next x
    Next
    
End Sub

答案1

得分: 1

这可以通过使用嵌套的For循环来实现,以避免重复迭代单元格。

Sub demo()
    Dim rCol, i, rSched As Range
    Set rSched = Range("B10:H20")
    For Each rCol In rSched.Columns
        For i = 1 To rCol.Cells.Count
            If rCol.Cells(i).Value = "somevalue" Then
                rCol.Cells(i).Resize(3, 1).MergeCells = True
                i = i + 2
            End If
        Next
    Next
End Sub
英文:

This can be accomplished using nested For loops to avoid iterating cells twice.

Sub demo()
    Dim rCol, i, rSched As Range
    Set rSched = Range("B10:H20")
    For Each rCol In rSched.Columns
        For i = 1 To rCol.Cells.Count
            If rCol.Cells(i).Value = "somevalue" Then
                rCol.Cells(i).Resize(3, 1).MergeCells = True
                i = i + 2
            End If
        Next
    Next
End Sub

huangapple
  • 本文由 发表于 2023年8月9日 07:26:41
  • 转载请务必保留本文链接:https://go.coder-hub.com/76863702.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定