☰

Excel VBA：如何将此代码乘以 10 次以用于 10 个不同的 H13、B13 单元格？

tag-icon • tag-icon microsoft-excel vba microsoft-excel-2007
Excel VBA：如何将此代码乘以 10 次以用于 10 个不同的 H13、B13 单元格？

我想知道如何使此代码适用于单元格 H13：H24 和 B13：B24，而不是仅适用于 H13 和 B13？（其他所有条件保持不变）

基本上将此代码乘以 10 次或 x 次，而无需再次编写 10 次并手动替换每行的 H13 和 B13。

我将使用此代码对不同列中的 400 个不同的 B13:B24 进行编码，并在代码中手动写入值（下面的代码只有其中 3 个）。如果您知道如何从该列中选择值，而不是将它们写在代码中，那么效果会更好。

这是代码：

Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("H14")) Is Nothing And (Range("B14") = "32849") Then
        For i = 7 To Columns.Count
            If Worksheets("Predare").Cells(1, i).EntireColumn.Hidden = False Then
                Worksheets("Predare").Range("G4").Offset(0, i - 7) = Worksheets("Predare").Range("G4").Offset(0, i - 7).Value + Target.Value
                GoTo MyEnd
            End If
        Next i
    End If
    If Not Intersect(Target, Range("H14")) Is Nothing And (Range("B14") = "79504") Then
        For i = 7 To Columns.Count
            If Worksheets("Predare").Cells(1, i).EntireColumn.Hidden = False Then
                 Worksheets("Predare").Range("G5").Offset(0, i - 7) = Worksheets("Predare").Range("G5").Offset(0, i - 7).Value + Target.Value
                GoTo MyEnd
            End If
        Next i
    End If
    If Not Intersect(Target, Range("H14")) Is Nothing And (Range("B14") = "10486") Then
        For i = 7 To Columns.Count
            If Worksheets("Predare").Cells(1, i).EntireColumn.Hidden = False Then
                 Worksheets("Predare").Range("G6").Offset(0, i - 7) = Worksheets("Predare").Range("G6").Offset(0, i - 7).Value + Target.Value
                GoTo MyEnd
            End If
        Next i
    End If
MyEnd:
End Sub

我尝试在范围定义中使用命名范围以及 H13:H24，但我可能做错了什么，因为它不起作用。

如果你有任何想法，非常感谢

=================================================

编辑：

我将添加 2 张实际 Excel 文件的图片，以便准确解释我的需求。请查看图片 1 和 2（代表同一个 Excel 文件中的 2 张工作表）：

预付卡

口头预付款流程表

我需要代码来做这样的事情：

如果 'Proces verbal de predare'!B14:B25 与以下值匹配任何细胞（因此顺序不同）从工作表 Predare！B4：B500，然后我在“Proces verbal de predare”！H14：H25 中写入的任何值，都执行：

Worksheets("Predare").Range("G4").Offset(0, i - 7) = Worksheets("Predare").Range("G4").Offset(0, i - 7).Value + Target.Value

但G4，我需要它是 Gn，其中 n = 'Proces verbal de predare' 里面写的代码的匹配行！B14:B25

答案1

这是解决问题的最终代码：

Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H14:H25")) Is Nothing Then
Dim ws2 As Worksheet: Set ws2 = Sheet2
Dim ws3 As Worksheet: Set ws3 = Sheet3
x = Application.Match(Range("B" & Target.Row), ws2.Range("B4:B500"), 0)
If IsNumeric(x) Then
For i = 7 To Columns.Count
If ws2.Cells(1, i).EntireColumn.Hidden = False Then
ws2.Range("G" & x + 3).Offset(0, i - 7) = ws2.Range("G" & x + 3).Offset(0, i - 7).Value2 & CStr(Target.Value)
GoTo MyEnd
End If
Next i
End If
End If
MyEnd:
End Sub

不能 100％ 确定这是否是您想要的，如果不是，请返回：

Option Base 1

    Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("H13:H24")) Is Nothing Then
        Dim MyArr1, MyArr2
        MyArr1 = Application.Transpose(Range("A13:A24")) ' Array of constants being checked
        MyArr2 = Application.Transpose(Range("B13:B24")) ' Array of variable values
            If MyArr1(Target.Row - 12) = MyArr2(Target.Row - 12) Then
                For i = 11 To Columns.Count
                    If Cells(1, i).EntireColumn.Hidden = False Then
                        Range("K4").Offset(0, i - 11) = Range("K4").Offset(0, i - 11).Value + Target.Text
                        GoTo MyEnd
                    End If
                Next i
            End If
        End If
    MyEnd:
    End Sub

注意：将要匹配的文本放在 A13:A24 中（即“10486”等），您可以将此范围隐藏在任何地方并进行调整以允许行。选项 Base 1 需要放在页面顶部，或者您可以删除此行，但数组将从 0 而不是 1 开始。如果您想修改以直接从工作表中工作，则实际上不需要使用数组。让我知道进展如何。

相关内容