【问题标题】:Loop through rows then columns in Excel循环遍历 Excel 中的行和列
【发布时间】:2019-09-10 17:30:23
【问题描述】:

我在excel中有一个统一的数据范围,A列有描述,B列有一个唯一的ID,C列是空白的。然后接下来的 3 列具有相同的数据集。我试图让我的 vba 循环遍历两组数据并比较唯一 ID,如果存在差异,它将其复制到数据范围到新工作表中。

问题在于它不仅仅是 6 列数据,它大约有几百列,因此在检查第一个数据范围后到达最后一行后,循环需要移动超过 6 列才能再次开始该过程.

一旦到达最后一行,我很难让循环跨 6 列移动

Sub finddata()

Dim s As Worksheet
Dim uniqueId As String
Dim finalrow As Long
Dim i As Long
Dim c As Long
Dim rngSearch As Range
Dim rngFound As Range
Dim finalcolumn As Long
Dim offset As Integer

Application.ScreenUpdating = True

uniqueId = Sheets("Data").Range("B2").Value
finalrow = Sheets("Data").Range("G100000").End(xlUp).Row
finalcolumn = Sheets("Data").Range("XFD1").End(xlToLeft).Column
offset = 3

Set s = Sheets("Data")
Set rngSearch = s.Range(s.Cells(2, 5), s.Cells(finalrow, 5))

Sheets("DataValidation").Range("A1:C100000").ClearContents

If i = finalrow GoTo 'guessing this is how to being to loop to move over columns
    For i = 2 To finalrow
        uniqueId = s.Cells(i, 2).Value
        Set rngFound = rngSearch.Find(What:=uniqueId, LookIn:=xlValues, LookAt:=xlWhole)
        If rngFound Is Nothing Then
            s.Range(Cells(i, 1), Cells(i, 6)).Copy
            Sheets("DataValidation").Range("A1048575").End(xlUp).offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
            End If
    Next i

MsgBox "Done"
End Sub

【问题讨论】:

  • If i = finalrow GoTo 你错过了它需要去的地方。另外,你能解释一下你的意图是什么吗?您从 datavalidation 中清除 A 到 C 列,然后在数据上查找某些内容,如果没有找到您将其粘贴到 datavalidation?
  • 嘿达米安,我把它放在那里,因为我认为这是第一步。所以一旦 i = 最后一行(它遍历所有行,然后它会转到下一个列)。该脚本遍历并在一个范围内找到任何不匹配的唯一 ID,因此它在三列中查找并与接下来的 3 列进行比较,并将任何错误数据粘贴到新工作表中。它只是清除工作表以开始
  • 通常你使用嵌套循环来做到这一点......这很容易,但我很难理解你的目标......如果你可以编辑你的问题并解释一下你在尝试什么我们可以帮忙。
  • 好的@Damian ,我尝试解决这个问题。希望它会有所帮助。 - 谢谢
  • 那么,一旦您检查了第一个集合(A、B、C 列与 D、E、F 列),下一个交互应该如何? A、B、C 与 G、H、I?

标签: excel vba loops


【解决方案1】:

试试那个

For j = 1 to finalcolumn step 6
    Set rngSearch = s.Range(s.Cells(2, j - 1 + 5), s.Cells(finalrow, j - 1 + 5))
    For i = 2 To finalrow
        uniqueId = s.Cells(i, 2 + j - 1).Value
        Set rngFound = rngSearch.Find(What:=uniqueId, LookIn:=xlValues, LookAt:=xlWhole)
            If rngFound Is Nothing Then
                s.Range(Cells(i, 1 + j - 1), Cells(i, 6 + j - 1)).Copy
                Sheets("DataValidation").Range("A1048575").End(xlUp). _
                               offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
            End If
    Next i
Next j

希望对你有帮助

【讨论】:

  • 我试了一下,对第一个列块效果很好,然后移到下一个列,但是在循环前 6 列之后它一直认为 rngFound 什么都不是?将不得不审查 rngSearch 变量以进行循环
  • 在第二个循环中设置 rngsearch
  • 完成。我之前没有检查过。
【解决方案2】:

这是一个简短示例,说明如何迭代 3 列的统一范围,并向右移动 6 的偏移量。你说你的范围是统一的,所以我硬编码了 rngSet 的初始值。

在 For Each 中,我正在打印单元格的地址,但您可以在那里进行检查。 While 循环将在到达空单元格时结束。

Dim rngSet As Range, rngRow As Range

Set rngSet = Range("A1:B6")

While Not IsEmpty(rngSet.Cells(1, 1).Value)

    For Each rngRow In rngSet.Rows
        Debug.Print rngRow.Cells(1, 1).Address
    Next rngRow

    Set rngSet = rngSet.Offset(0, 6)
Wend

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-06-28
    • 1970-01-01
    • 2021-12-07
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多