Question

今天我正在尝试开发一个VBA脚本，以便一次循环指定的第4行单元格。

对于我的项目，我试图确定某个网站是否在特定旅行中进行了调查。我正在使用quattro pro开发的电子表格，其中包含超过20年的数据。每个调查都有4个单元格，我想检查它们是否有值。每个站点有三种可能的情况：1）所有四个单元格包含值，2）中间2个单元格包含值或3）没有单元格具有值。就我的目的而言，我只关注情况1和2.

我开发了一个代码来查找值，如果找到它们会在数组中添加一行：

Sub Find_Site_Name()

Dim LU_Row_rng As Range                                     'Variable for each survey date row
Dim Survey_Site(0 To 85, 0 To 5) As String                   'overall array for output
Dim SurveyDate As String                                    'Variable declared at begining for survey date in question
Dim Site_ID As String                                       'Variable declared for the site being questioned
Dim N As Integer                                            'Counter used to determine which the next row in the array is for
Dim NN As Integer                                           'Counter used to determine which row we are thinking about

'Add header to array
Survey_Site(0, 0) = "Date"
Survey_Site(0, 1) = "Site"
Survey_Site(0, 2) = "EddyMinto8k"
Survey_Site(0, 3) = "Eddy8kto25k"
Survey_Site(0, 4) = "EddyAbv25k"
Survey_Site(0, 5) = "ChanMinto8k"

Set LU_Row_rng = Range("H4:OY4")

'Set the survey Site ID and Trip Begin Date

'Start Counter so we will it will begin on first survey's row
NN = 4

'Start counter so it will begin on row 2 of array
N = 1

For Each Rng In LU_Row_rng
Rng.Select
    Site_ID = Rng.Offset(-3)

    'Add site id and trip begin date to array

    Survey_Site(1, 1) = Site_ID
    SurveyDate = Range(Cells(NN, 2), Cells(NN, 2)).Value
    Survey_Site(1, 0) = SurveyDate
        'Check to see if eddyminto8k bin has number
        If Rng.Value <> "" Then

        'Eddyminto8k bin has number --> add to array and check next cell
        Survey_Site(N, 2) = "Yes"
        Survey_Site(N, 3) = "Yes"
        Survey_Site(N, 4) = "Yes"
        Survey_Site(N, 5) = "Yes"

         Else
         'Eddymintto8k doesnt have number --> add no number to array and check next cell

            If Rng.Offset(0, 1) <> "" Then
            'There was a survey but did not have bathymetry
            Survey_Site(N, 2) = "NO"
            Survey_Site(N, 3) = "Yes"
            Survey_Site(N, 4) = "Yes"
            Survey_Site(N, 5) = "NO"

            Else
            'There was no survey on this trip --> set counter back one so there wont be a blank row
            N = N - 1

            End If

        'Add one to counter to move to next row of array
        N = N + 1

        End If

'Jump rng forward so next rng will be directly before the next line of interest
Set Rng = Rng.Offset(0, 3)
Rng.Select

Next Rng


End Sub

我的问题是For Each Rng In LU_Row_rng循环想要逐个单元地移动。我尝试通过编写Set Rng = Rng.Offset(0, 3)行来更改循环正在查看的当前单元格，但是当代码执行next rng行时，该方法不起作用。

Answer 1

Set LU_Row_rng = Range("H4:OY4")

Set Rng = LU_Row_rng.cells(1).Resize(1,4)
do while not application.intersect(rng,LU_Row_rng) Is Nothing
    '...work with rng
    Set Rng = rng.offset(0,4)
loop

用于循环以一次循环范围和单元格

1 个答案: