Question

我正在遍历工作簿并在同一行中搜索person1和val1的次数，然后在每次发生这种情况时将1添加到指定的单元格。我可以完成这项工作的唯一方法是为每个人复制并粘贴以下代码。这对于很多人而言效率太低，而且excel不会运行它，有什么建议可以避免大规模复制和粘贴吗？

Sub Main()

    Dim ws As Worksheets 'remember which worksheet is active in the beginning
    Dim starting_ws As Worksheet
    Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
    'Set MyRng =
    ws_num = ThisWorkbook.Worksheets.Count - 4

    For I = 1 To ws_num
        ind = 9
        ThisWorkbook.Worksheets(I).Activate
        Do While ind <= 39


            If Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val1" Then
                Worksheets("scrap").Range("C7").Value = Worksheets("scrap").Range("C7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val2" Then
                Worksheets("scrap").Range("B7").Value = Worksheets("scrap").Range("B7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val3" Then
                Worksheets("scrap").Range("D7").Value = Worksheets("scrap").Range("D7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val4" Then
                Worksheets("scrap").Range("E7").Value = Worksheets("scrap").Range("E7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val5" Then
                Worksheets("scrap").Range("F7").Value = Worksheets("scrap").Range("F7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val6" Then
                Worksheets("scrap").Range("G7").Value = Worksheets("scrap").Range("G7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val7" Then
                Worksheets("scrap").Range("H7").Value = Worksheets("scrap").Range("H7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val8" Then
                Worksheets("scrap").Range("I7").Value = Worksheets("scrap").Range("I7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val9" Then
                Worksheets("scrap").Range("J7").Value = Worksheets("scrap").Range("J7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val10" Then
                Worksheets("scrap").Range("K7").Value = Worksheets("scrap").Range("K7").Value + 1
            ElseIf Worksheets(I).Range("A" & ind).Value = "person1" And Worksheets(I).Range("G" & ind).Value = "val11" Then
                Worksheets("scrap").Range("L7").Value = Worksheets("scrap").Range("L7").Value + 1



            End If
            ind = ind + 1
        Loop


    Next

Answer 1

首先，您可以使用：

If Worksheets(I).Range("A" & ind).Value = "person1" Then

仅评估一次。然后使用

Select Case Worksheets(I).Range("G" & ind).Value
    Case "val1" 
        Worksheets("scrap").Range("C7").Value = Worksheets("scrap").Range("C7").Value + 1
    Case "val2"
        Worksheets("scrap").Range("B7").Value = Worksheets("scrap").Range("B7").Value + 1

等等

正如urdearboy所阐明的，上面应该在循环中，取代所有If...Elseifs

Answer 2

在cybernetic.nomads解决方案的基础上，您可以将您的Case放在数组Persons的循环中。当然，您需要使用要循环的所有值来更新此数组。

使你的＆＃34; Scrap＆＃34;变暗出于美学原因的工作表尽可能删除了.Value 关闭ScreenUpdating以获得更好的备用内存。

Sub Main()

Dim ws As Worksheets 'remember which worksheet is active in the beginning
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
ws_num = ThisWorkbook.Worksheets.Count - 4

Dim Scrap As Worksheet
Set Scrap = ThisWorkbook.Sheets("Scrap")

Dim P As Integer
Dim Persons As Variant
Persons = Array("person1", "person2", "person3", "personN")        

Application.ScreenUpdating = False

For P = LBound(Persons) To UBound(perons)
    For I = 1 To ws_num
    ind = 9
        Do While ind <= 39
            If Worksheets(I).Range("G" & ind).Value = Persons(P) Then
                Select Case Worksheets(I).Range("G" & ind.Value)
                    Case "val1"
                        Scrap.Range("C7") = Scrap.Range("C7").Value + 1
                    Case "val2"
                        Scrap.Range("B7") = Scrap.Range("B7").Value + 1
                    Case "val3"
                         Scrap.Range("D7") = Scrap.Range("D7").Value + 1
                    Case "val4"
                         Scrap.Range("E7") = Scrap.Range("E7").Value + 1
                    Case "val5"
                         Scrap.Range("F7") = Scrap.Range("F7").Value + 1
                    Case "val6"
                         Scrap.Range("G7") = Scrap.Range("G7").Value + 1
                    Case "val7"
                         Scrap.Range("H7") = Scrap.Range("H7").Value + 1
                    Case "val8"
                         Scrap.Range("I7") = Scrap.Range("I7").Value + 1
                    Case "val9"
                         Scrap.Range("J7") = Scrap.Range("J7").Value + 1
                    Case "val0"
                         Scrap.Range("J7") = Scrap.Range("K7").Value + 1
                    Case "val11"
                         Scrap.Range("L7") = Scrap.Range("L7").Value + 1
                End Select
            End If
        ind = ind + 1
        Loop
    Next I
Next P

Application.ScreenUpdating = True


End Sub

VBA-通过工作表迭代并查找值的出现，使其更有效

2 个答案: