首页 > 解决方案 > 如何循环遍历一系列单元格?

问题描述

我在此“样本分析数据”表中有 B2:B10 范围内的值。

对于范围内的每个单元格,代码会在“元数据”表中查找该值。然后它复制该行中的单元格并将其粘贴到“示例分析数据”中(搜索值的右侧)。这适用于 B2 中的值。

我无法让它继续前进到 B3,然后是 B4 等。它会循环并再次为 B2 做同样的事情。

Sub GetMetaData()

    Worksheets("Sample Analysis Data").Activate
    Range("B2").Select

    Dim srch As Range, cell As Variant
    Set srch = Range("B2:B10")

    For Each cell In srch
        Sheets("Meta Data").Activate

        Cells.Find(What:=cell, LookIn:=xlValues, LookAt:= _
          xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
          , SearchFormat:=False).Activate

        ActiveSheet.Cells(ActiveCell.Row, 1).Select
        Range(ActiveCell, ActiveCell.End(xlToRight).End(xlToRight)).Select

        Application.CutCopyMode = False
        Selection.Copy

        Sheets("Sample Analysis Data").Activate

        ActiveCell.Offset(0, 7).Select
        ActiveSheet.Paste

    Next cell
End Sub

标签: excelvba

解决方案


尝试这个?将 i=8 更改为您需要偏移的单元格数量(您指示 B2:B10,即 8)

Sub testcopy()

    Dim srch As Range, metarg As Range, rg As Range, pstrg As Range
    Dim i As Long
    Dim ws As Worksheet, ws2 As Worksheet

    Set ws = ThisWorkbook.Sheets("Sample Analysis Data")
    Set ws2 = ThisWorkbook.Sheets("Meta Data")

    Set metarg = ws2.Range("A1:A100") 'range that includes the key that you are searching in B2:B10

    Set srch = ws.Range("B1")  'i'm offsetting, so i'm going back one row
    For i = 1 To 8 'change 8 to how many cells to offset
        Set rg = metarg.Find(srch.Offset(i, 0).Value, LookIn:=xlValues, lookat:=xlWhole) 'find the value in meta sheet
        If Not rg Is Nothing Then
            Set pstrg = ws2.Range(rg, ws2.Cells(rg.Row, rg.End(xlToRight).Column))
            pstrg.Copy
            srch.Offset(i, 1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next i

    End Sub

推荐阅读