【问题标题】:Can anyone optimize this code so that I do not need 100 variables?任何人都可以优化此代码,以便我不需要 100 个变量吗?
【发布时间】:2021-11-10 02:40:49
【问题描述】:

谁能帮我优化这段代码?我很确定一定有更好的方法来编码,但想不出。我希望每个变量都是动态可用的,并且仅在需要时才创建。我真的不想对所有 100 个变量重复此操作。

Sub vba_loop_sheets()

Dim i As Long 'Base sheet
Dim ii As Long 'Moving sheet
Dim shtCount As Long
Dim ans1, ans2, ans3, ans4, ans5, ans6, ans7, ans8, ans9, ans10, ans11, ans12, ans13, ans14, ans15, ans16, ans17, ans18, ans19, ans20, ans21, ans22, ans23, ans24, ans25, ans26, ans27, ans28, ans29, ans30, ans31, ans32, ans33, ans34, ans35, ans36, ans37, ans38, ans39, ans40, ans41, ans42, ans43, ans44, ans45, ans46, ans47, ans48, ans49, ans50, ans51, ans52, ans53, ans54, ans55, ans56, ans57, ans58, ans59, ans60, ans61, ans62, ans63, ans64, ans65, ans66, ans67, ans68, ans69, ans70, ans71, ans72, ans73, ans74, ans75, ans76, ans77, ans78, ans79, ans80, ans81, ans82, ans83, ans84, ans85, ans86, ans87, ans88, ans89, ans90, ans91, ans92, ans93, ans94, ans95, ans96, ans97, ans98, ans99, ans100 As Variant

shtCount = Sheets.count - 1

For i = 7 To shtCount
For ii = i + 1 To shtCount

    If Sheets(i).Range("B1").Value = Sheets(ii).Range("B1").Value And ans1 = "" Then
    
    ans1 = Abs(Sheets(i).Range("B8").Value - Sheets(ii).Range("B8").Value)
    
    ThisWorkbook.Sheets("calc").Range("F5").Formula = "=" & ans1
    
    
    ElseIf Sheets(i).Range("B1").Value = Sheets(ii).Range("B1").Value And ans2 = "" Then
    
    ans2 = Abs(Sheets(i).Range("B8").Value - Sheets(ii).Range("B8").Value)
    
    ThisWorkbook.Sheets("calc").Range("F5").Formula = "=" & ans1 & "+" & ans2
    
    
    ElseIf Sheets(i).Range("B1").Value = Sheets(ii).Range("B1").Value And ans3 = "" Then
    
    ans3 = Abs(Sheets(i).Range("B8").Value - Sheets(ii).Range("B8").Value)
    
    ThisWorkbook.Sheets("calc").Range("F5").Formula = "=" & ans1 & "+" & ans2 & "+" & ans3

    End If

Next ii
Next i

End Sub

【问题讨论】:

  • 你能概括一下你想要做什么吗?
  • 我为每个变量添加了一个额外的 elseif,所以下一行是 ans4,然后重复直到 ans100。从广义上讲,我试图获得 2 个单元格的差异,然后将它们加在一起,让每个值显示在公式中。我想优化从 ans1 到 ans100 重复每个 elseif 的部分
  • 还与:stackoverflow.com/questions/69170222/… 相关,如果能够优化,将给予这两个帖子的功劳!

标签: excel vba excel-formula


【解决方案1】:

使用数组代替许多变量

Option Explicit

Sub VbaLoopSheets()
    
    Const MaxExpectedAnswers As Long = 100
    Const FirstSheetIndex As Long = 7
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim LastSheetIndex As Long: LastSheetIndex = wb.Sheets.Count - 1
    Dim Answers() As String: ReDim Answers(1 To MaxExpectedAnswers)
    
    Dim wsb As Worksheet
    Dim wsm As Worksheet
    Dim b As Long ' Base Sheet
    Dim m As Long ' Moving Sheet
    Dim a As Long ' Answer
    
    For b = FirstSheetIndex To LastSheetIndex
        Set wsb = wb.Sheets(b)
        For m = b + 1 To LastSheetIndex
            Set wsm = wb.Sheets(m)
            If wsb.Range("B1").Value = wsm.Range("B1").Value Then
                a = a + 1
'                If a > MaxExpectedAnswers Then
'                    MsgBox "Too many answers.", vbCritical, "VBA Loop Sheets"
'                    Exit Sub
'                End If
                Answers(a) = Abs(wsb.Range("B8").Value - wsm.Range("B8").Value)
            End If
        Next m
    Next b

    With wb.Worksheets("Calc").Range("F5")
        If a = 0 Then
            .Value = ""
        Else
            If a < MaxExpectedAnswers Then
                ReDim Preserve Answers(1 To a)
            End If
            .Formula = "=" & Join(Answers, "+")
        End If
    End With

End Sub

【讨论】:

    猜你喜欢
    • 2020-01-19
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2022-11-15
    • 2016-04-29
    • 2019-12-29
    • 2018-04-13
    • 1970-01-01
    相关资源
    最近更新 更多