Excel通过工作表进行迭代 [英] Excel iterate through worksheets

问题描述

我有一个工作簿有许多表，有些我需要输入一个值，如果前面的单元格匹配一个给定的字符串。

我的代码适用于我需要的工作表，但是当它到达一些不需要的工作表时（它们中也有数据）会出错。

调试器亮点的行为 For Each r In Inectect（ActiveSheet.UsedRange，Range（F：F）我是一个VBA / Excel脚本的新手，对不起，如果这是明显的，但我搜索的网站，找不到适合的答案，或者我只是不认识。

  Sub AllOnePool（）
 Dim myStr As String 
 Dim myPool As String 
 Dim sh As Worksheet 
 Dim xlCalc As XlCalculation 
 
 myStr = InputBox（Prompt：=输入目标序列号：例如93127）
 myPool = InputBox（Prompt：=输入要使用的池）
 
对于每个sh在ActiveWorkbook.Worksheets 
 sh.Activate 
对于每个r In Inectect（ActiveSheet.UsedRange，Range（F：F））
如果r .Text = myStr Then 
 r.Offset（0，1）= myPool 
 End If 
 Next r 
 Next sh 
 
 End Sub 
  

解决方案

您需要检查两个范围是否相交：

  Sub AllOnePool（）
 Dim myStr As String 
 Dim myPool As String 
 Dim sh As Worksheet 
 Dim cel As Range 
 Dim xIng As Range 
 
 myStr = InputBox（Prompt：=输入目标序列号：即93127）
 myPool = InputBox（Prompt：=输入要使用的池：）
 
对于每个sh在ActiveWorkbook.Worksheets 
 With sh 
设置xIng = Intersect（.UsedRange，.Range（F：F））
如果不是xIng不是然后
对于每个cel在xIng 
如果cel.Text = myStr Then cel.Offset（0，1）= myPool 
 Next 
 End If 
 End With 
 Next 
 End Sub 
  

I have a workbook with many sheets and into some I need to enter a value if the preceding cell matches a given string.

My code works for the sheets I need it to but it errors out when it reaches some non desired sheets (that also have data in them).

The line the Debugger highlights is For Each r In Intersect (ActiveSheet.UsedRange, Range("F:F") I'm a newbie with VBA/Excel scripting. Sorry if this is blindingly obvious but I searched the site and couldn't find an answer that fit, or I just didn't recognize it.

Sub AllOnePool()
    Dim myStr As String
    Dim myPool As String
    Dim sh As Worksheet
    Dim xlCalc As XlCalculation

    myStr = InputBox(Prompt:="Input the Target Serial Number: e.g. 93127")
    myPool = InputBox(Prompt:="Input the Pool to Use: ")

    For Each sh In ActiveWorkbook.Worksheets
        sh.Activate
        For Each r In Intersect(ActiveSheet.UsedRange, Range("F:F"))
            If r.Text = myStr Then
                r.Offset(0, 1) = myPool
            End If
        Next r
    Next sh

End Sub

解决方案

You need to check that the 2 ranges intersect:

Sub AllOnePool()
    Dim myStr As String
    Dim myPool As String
    Dim sh As Worksheet
    Dim cel As Range
    Dim xIng As Range

    myStr = InputBox(Prompt:="Input the Target Serial Number: i.e. 93127")
    myPool = InputBox(Prompt:="Input the Pool to Use: ")

    For Each sh In ActiveWorkbook.Worksheets
        With sh
            Set xIng = Intersect(.UsedRange, .Range("F:F"))
            If Not xIng Is Nothing Then
                For Each cel In xIng
                    If cel.Text = myStr Then cel.Offset(0, 1) = myPool
                Next
            End If
        End With
    Next
End Sub

这篇关于Excel通过工作表进行迭代的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！