在两个不同的列中进行双循环+子程序调用

时间：2014-01-23 16:25:02

标签： loops excel-vba for-loop goto vba

背景

第一个子检查工作表“sheet1”中“A列”中每个单元格的格式，通过遍历每个单元格（模板）中的相同列，如果没有找到相似的子句则调用子程序FlagError来存储错误在sheetname＆amp; now（现在的部分允许我每秒创建一个新的错误表而不会重复）工作表。

的问题：

  • 表示超出范围并突出显示该行的错误 表格（“模板”）。激活：已解决：错过了“”。感谢simoco指出这一点。

  • 我想摆脱所有goto语句，但我有限的技术知识很好..限制我，有人可以帮我修改代码。

这些东西： 

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

1 个答案:

答案 0 :(得分：0)

这个答案的第一个版本要求在前两个评论中给出澄清。

更改1

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

更改2

当您在12个月内回到此例程时，您是否会立即知道i，j和counter是什么？您需要一个系统来命名变量，以便您（或同事）在忘记之后轻松告诉他们的目的。您可能不喜欢我的命名系统。好的，选一个你喜欢的。

Your name   My name
    i       RowSheet1Crnt
    j       RowTemplateCrnt
 counter    RowErrorCrnt

更改3

你有：

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但您应该替换此名称。

所以我会有以下内容，但其他更改：

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，每次切换时都会有一定数量的屏幕重新绘制。如果可能，这是一个避免的声明。考虑：

CellValueSheet1Test = Cells(RowSheet1Crnt, ucolumn).Value

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

第一个语句在活动工作表上运行。在第二组中，Cells之前的点表示此操作在With语句中指定的工作表上运行。我不必切换到工作表来访问其内容。

With可以嵌套：

With Worksheets("Sheet1")
  With .Cells(RowSheet1Crnt, ucolumn)
    .Value = "X"
    .Font.Bold = True
    .Font.Color = RGB(0, 255, 255)
  End With
End With

更改6

如果我对特定工作表做了很多工作，我会使用With Worksheets语句。您一次只能访问一个单元格，并且可以通过引用更快地访问工作表。

我有：

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 VBA的一个难点在于通常有几种方法可以达到相同的效果，而且最好使用它并不总是很明显。我发现每个程序员都有他们自己的最爱 - 你看到我的。麻烦的是，当你看到不同程序员的工作时，每个人都会有自己的最爱。你必须意识到每种技术，即使你不喜欢它们，因为其他人使用它们。

更改7

你有：

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的代码之间存在任何差异，所以我已经合并了。我认为使用xcheck1和xcheck2没有任何优势，但对于其他更改，这将成为：

If Len(r) = 14 Or Len(r) = 15 Then
    If r Like samplenof Then
    GoTo nexti1
    Else
     GoTo nextj1
    End If

更改8

GoTo的代码块让我最难以理解你想要实现的目标。

在我看来，如果工作表“Sheet1”中的值的长度不是14或15，则是错误;没有必要检查工作表“模板”。因此可以在内循环之外进行测试。如果工作表“Sheet1”中的值不是Like工作表“模板”中的任何值，我想您希望报告错误。您在FlagErrors上方呼叫Else，但我看不到它可以被执行。我已经完成了对这个区块的重新编码，但我无法确定我是否达到了你想要的效果。

不变

您使用：

FlagErrors ucolumn, RowSheet1Crnt, CellValueSheet1Test, RowErrorCrnt

我更喜欢：

Call FlagErrors(ucolumn, RowSheet1Crnt, CellValueSheet1Test, RowErrorCrnt)

我的偏好可能更多地与我所知道的其他编程语言有关。我不知道任何其他语言允许您使用的格式。但是，我不知道你的格式有什么缺点，所以我把它留下了。

修改后的代码

我无法测试此代码。我已经解释了每一个变化，如果它不能按你的意愿工作，你应该能够找出原因。祝你好运。

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
相关问题
最新问题