首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >两种不同的columns+subroutine调用中的双循环

两种不同的columns+subroutine调用中的双循环
EN

Stack Overflow用户
提问于 2014-01-23 16:25:02
回答 1查看 75关注 0票数 0

背景:

第一个子程序检查工作表"sheet1“中”列A“中每个单元格的格式,通过遍历工作表(模板)中的每个单元格,如果没有发现相似的子例程FlagError来存储工作表名中的错误(现在部分允许我每秒钟创建一个新的错误表而不需要重复)工作表。

问题:

  • 一个错误说工作表超出了范围并突出显示了行表(“模板”).activate:解决了:缺少了“.Thanks simoco”来指出这一点。
  • 我想摆脱所有的后藤声明,但我有限的技术知识是很好的。限制我,有人能帮我修改代码吗?

The:

代码语言:javascript
复制
Global sheetname As String

Sub errorsinsight_plus()
     sheetname = "errorsheet" & Format(Now, "yyyy_mm_dd ss_nn_hh")
    Dim i As Long, r As Range, j As Long
    Dim ucolumn As String
    Dim counter As Integer: counter = 1

Sheets.Add.Name = sheetname

    Sheets("sheet1").Activate

 ' if your data is in a different column then change A to some other letter(s)
    ucolumn = "A" 'sample number

  'finds error in sample code


For i = 2 To Range(ucolumn & Rows.Count).End(xlUp).Row
        Set r = Range(ucolumn & i)
Dim samplenof As Range
Sheets("template").Activate
For j = 1 To Range(ucolumn & Rows.Count)
Set samplenof = Range(ucolumn & j)
  Sheets("Sheet1").Activate
   If Len(r) = 14 Then
     Dim xcheck1 As Boolean
     xcheck1 = r Like samplenof
        If xcheck1 = True Then
        GoTo nexti1
        Else
         GoTo nextj1
        End If
   ElseIf Len(r) = 15 Then
     Dim xcheck2 As Boolean
     xcheck2 = r Like samplenof
        If xcheck2 = True Then
        GoTo nexti1
        Else
       GoTo nextj1
        End If
  FlagErrors ucolumn, i, r, counter
  Else: FlagErrors ucolumn, i, r, counter
  End If
nextj1:
   Next j
nexti1:
Next i

end sub

Public Sub FlagErrors(ucolumn As String, i As Long, r As Range, ByRef counter As Integer)
    Sheets(sheetname).Activate
    Dim xerror As Range, yerror As Range
    Range("A" & counter) = ucolumn & i
    Range("B" & counter) = r
    Sheets("sheet1").Activate
    counter = counter + 1
End Sub
EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2014-01-23 17:36:18

这一答复的第一稿要求澄清前两项评论中所作的澄清。

变化1

我在顶部增加了Option Explicit。这导致编译器坚持声明所有变量。没有它,像Count = Conut + 1这样的语句就会隐式声明Conut。找到这些错误可能是一场噩梦。

变更2

当你在12个月后回到日常生活中,你会立即知道ijcounter是什么吗?你需要一个命名变量的系统,这样你(或同事)就可以在你忘记了之后很容易地知道他们的目的。你可能不喜欢我的命名系统。好吧,选一个你喜欢的。

代码语言:javascript
复制
Your name   My name
    i       RowSheet1Crnt
    j       RowTemplateCrnt
 counter    RowErrorCrnt

变更3

你有:

代码语言:javascript
复制
Set r = Range(ucolumn & i)
If Len(r) = 14 Then

r是一个范围。范围的默认属性是Value。因此,Len(r)相当于Len(r.Value)。但是,当我看到Len(r)时,我必须知道r是一个单细胞范围来解密这个语句。我避免假设任何对象的默认属性。对于范围,我总是包括.Value,因为我相信它使代码更易读。

但是,您只使用r来获取值。我已经删除了r并将其替换为一个字符串变量。我不知道Range(ucolumn & i)是什么,所以我不能给它取一个有意义的名字。我选择了CellValueSheet1Test,但是你应该替换这个名字。

因此,除其他改动外,我还有以下几点:

代码语言:javascript
复制
CellValueSheet1Test = Range(ucolumn & RowSheet1Crnt).Value
If Len(CellValueSheet1Test) = 14 Then

变更4

你使用Range(ucolumn & RowSheet1Crnt).Value。我用过Cells(RowSheet1Crnt, ucolumn)Range没有什么问题,但我发现Cells更灵活。第二个参数可以是列标识符(如"A“),也可以是列号(如1 )。当您跨多个列操作时,这是非常方便的。

变化5

使用“激活”切换工作表。即使包括Application.ScreenUpdating = False,每次切换时也会有一定数量的屏幕重绘。如果可能的话,这是一个应该避免的声明。考虑:

代码语言:javascript
复制
CellValueSheet1Test = Cells(RowSheet1Crnt, ucolumn).Value

With Worksheets("Sheet1")
  CellValueSheet1Test = .Cells(RowSheet1Crnt, ucolumn).Value
End With

第一条语句在活动工作表上操作。在第二组中,Cells之前的点意味着这在With语句中指定的工作表上操作。我不必切换到工作表来访问它的内容。

Withs可以嵌套:

代码语言:javascript
复制
With Worksheets("Sheet1")
  With .Cells(RowSheet1Crnt, ucolumn)
    .Value = "X"
    .Font.Bold = True
    .Font.Color = RGB(0, 255, 255)
  End With
End With

Change 6

如果我对特定的工作表做了很多事情,我会使用With Worksheets语句。一次只访问一个单元格,通过引用访问工作表的速度更快。

我有:

代码语言:javascript
复制
Dim WshtSheet1 As Worksheet
Dim WshtTemplate As Worksheet

Set WshtSheet1 = Worksheets("Sheet1")
Set WshtTemplate = Worksheets("template")

CellValueSheet1Test = WshtSheet1.Cells(RowSheet1Crnt, ucolumn).Value

我认为这绝对是访问工作表"Sheet1“的最佳方式。我对工作表的“模板”使用了同样的技术,但有些人可能会认为With会更好。Excel的一个困难是通常有几种方法可以实现相同的效果,而且并不总是很明显,哪一种是最好使用的。我发现每个程序员都有他们自己的最爱--你看到我的了。问题在于,当您查看不同程序员的工作时,每个程序员都会有自己的最爱。你必须意识到每一种技术,即使你不喜欢它们,因为其他人使用它们。

Change 7

你有:

代码语言:javascript
复制
If Len(r) = 14 Then
  Dim xcheck1 As Boolean
  xcheck1 = r Like samplenof
    If xcheck1 = True Then
    GoTo nexti1
    Else
     GoTo nextj1
    End If
ElseIf Len(r) = 15 Then
  Dim xcheck2 As Boolean
  xcheck2 = r Like samplenof
    If xcheck2 = True Then
      GoTo nexti1
    Else
     GoTo nextj1
    End If

我看不出长度14和15的代码之间有什么不同,所以我已经把它们合并了。我认为这样使用xcheck1xcheck2没有好处,但对于其他更改,这将变成:

代码语言:javascript
复制
If Len(r) = 14 Or Len(r) = 15 Then
    If r Like samplenof Then
    GoTo nexti1
    Else
     GoTo nextj1
    End If

变更8

使用GoTos的代码块给我带来了最大的困难,试图理解您想要实现的目标。

在我看来,如果工作表"Sheet1“的值的长度不是14或15,这是一个错误;不需要检查工作表”模板“。这样测试就可以在内环外进行。我认为,如果工作表"Sheet1“的值不是Like工作表”模板“中的任何值,则需要报告错误。您的FlagErrors调用就在Else之上,但我看不出可以执行它。我已经完成了这个街区的重新编码,但我不能肯定我已经达到了你想要的效果。

不变

你用:

代码语言:javascript
复制
FlagErrors ucolumn, RowSheet1Crnt, CellValueSheet1Test, RowErrorCrnt

我更喜欢:

代码语言:javascript
复制
Call FlagErrors(ucolumn, RowSheet1Crnt, CellValueSheet1Test, RowErrorCrnt)

我的偏好可能更多地与我所知道的其他编程语言有关。我不知道任何其他语言,允许您使用的格式。但是,我不知道您的格式有什么缺点,所以我已经离开了。

修改代码

我没有办法测试这段代码。我已经解释了每一个改变,所以如果它不像你所希望的那样起作用,你应该能够找出原因。祝好运。

代码语言:javascript
复制
Option Explicit
Global sheetname As String

Sub errorsinsight_plus()

    Application.ScreenUpdating = False

    sheetname = "errorsheet" & Format(Now, "yyyy_mm_dd ss_nn_hh")

    Dim ucolumn As String

    Dim CellValueSheet1Test As String
    Dim CellValueTemplateTest As String
    Dim MatchFound As Boolean
    Dim RowErrorCrnt As Long
    Dim RowSheet1Crnt As Long
    Dim RowSheet1Last As Long
    Dim RowTemplateCrnt As Long
    Dim RowTemplateLast As Long
    Dim WshtSheet1 As Worksheet
    Dim WshtTemplate As Worksheet

    Set WshtSheet1 = Worksheets("Sheet1")
    Set WshtTemplate = Worksheets("template")

    Sheets.Add.Name = sheetname

    ' if your data is in a different column then change A to some other letter(s)
    ucolumn = "A" 'sample number

    RowSheet1Last = WshtSheet1.Cells(Rows.Count, ucolumn).End(xlUp).Row
    RowTemplateLast = WshtTemplate.Cells(Rows.Count, ucolumn).End(xlUp).Row
    RowErrorCrnt = 1

    'finds error in sample code
    For RowSheet1Crnt = 2 To RowSheet1Last
      CellValueSheet1Test = WshtSheet1.Cells(RowSheet1Crnt, ucolumn).Value
      If Len(CellValueSheet1Test) = 14 Or _
         Len(CellValueSheet1Test) = 15 Then
        MatchFound = False
        For RowTemplateCrnt = 2 To RowTemplateLast
          CellValueTemplateTest = WshtTemplate.Cells(RowTemplateCrnt, ucolumn).Value
          If CellValueSheet1Test Like CellValueTemplateTest Then
            MatchFound = True
            Exit For
          End If
        Next
      Else
        ' Length of test value is neither 14 or 15.
         FlagErrors ucolumn, RowSheet1Crnt, CellValueSheet1Test, RowErrorCrnt
      End If
      If Not MatchFound Then
        FlagErrors ucolumn, RowSheet1Crnt, CellValueSheet1Test, RowErrorCrnt
      End If
    Next RowSheet1Crnt

End Sub
Public Sub FlagErrors(ByVal ucolumn As String, ByVal RowSheet1 As Long, _
                      ByVal CellValueSheet1 As String, ByRef RowError As Long)

  With Sheets(sheetname)
    .Cells(RowError, "A").Value = ucolumn & RowSheet1
    .Cells(RowError, "B").Value = CellValueSheet1
    RowError = RowError + 1
  End With

End Sub
票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/21313834

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档