循环一次循环范围n个单元格
今天我正在尝试开发一个VBA脚本来一次循环指定的第4行单元格。
对于我的项目，我试图确定一个网站是否在特定的旅程中进行了调查。 我正在使用包含20多年数据的quattro pro开发的电子表格。 每个调查有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循环中的For Each Rng In LU_Row_rng想要逐个单元格地移动。 我试图通过编写Set Rng = Rng.Offset(0, 3)行来更改循环所在的当前单元，但是当代码执行next rng行时，该方法不起作用。
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