Question

我有一个＆＃39;功能＆＃39;模块，我保留了一堆有用的代码，减少了编码时间和冗余。我真正想做的就是尽可能地将代码夹在中间。我遇到的问题是你不能放置一个＆＃39; Next＆＃39;与＆＃39; For＆＃39;在同一条线上的指令和＆＃39;如果＆＃39;。

这是我目前所拥有的（这些是多用途功能，所以请原谅这些变体：P）：

Function GetArrCol(xArray As Variant, xHeaderName As Variant, xHeaderRow As Variant) As Variant
Dim jCol As Long
For jCol = LBound(xArray, 2) To UBound(xArray, 2): If xArray(xHeaderRow, jCol) = xHeaderName Then GetArrCol = jCol: Exit For
Next jCol
If GetArrCol = Empty Then GetArrCol = "Error: Column Header Not Found"
End Function

我希望自己能成为什么：

Function GetArrCol(xArray As Variant, xHeaderName As Variant, xHeaderRow As Variant) As Variant
Dim jCol As Long
For jCol = LBound(xArray, 2) To UBound(xArray, 2): If xArray(xHeaderRow, jCol) = xHeaderName Then GetArrCol = jCol: Exit For: Next jCol
If GetArrCol = Empty Then GetArrCol = "Error: Column Header Not Found"
End Function

我并不认为这是可能的，但值得一提。

Answer 1

将for循环更改为Do：

Function GetArrCol2(xArray As Variant, xHeaderName As Variant, xHeaderRow As Variant) As Variant
Dim xTestVal As Variant: On Error Resume Next: GetArrCol2 = (LBound(xArray, 2) - 1): Do:: GetArrCol2 = (GetArrCol2 + 1): xTestVal = xArray(xHeaderRow, GetArrCol2): Loop Until xTestVal = xHeaderName Or (GetArrCol2 = UBound(xArray, 2) + 1): On Error GoTo 0
If GetArrCol2 = (UBound(xArray, 2) + 1) Then GetArrCol2 = "Error: Column Header Not Found"
End Function

Answer 2

我是缩小代码的粉丝，但我必须承认不会达到您展示的程度！

但是你的问题和其他人的评论引发了我的思考，我走到了以下

想到/搜索特定问题的最佳解决方案

任何特定问题都有许多解决方案，这些解决方案可能在不同的环境中有所不同

一个问自己的好问题是：“有没有内置功能”可以利用？
指导您缩小工作量，编写小段代码

这些辅助子/函数执行非常具体的工作并且做得很好

他们的维护非常简单快捷

构建一个类并公开其方法和属性

等一下：你确实可以！
设计和维护课程

这将带来非常高的灵活性和维护性

并且在某种程度上与VBA一致，对于多态性

所以采用代码的“正常”措辞：

Function GetArrCol(xArray As Variant, xHeaderName As Variant, xHeaderRow As Variant) As Variant
    Dim jCol As Long
    For jCol = LBound(xArray, 2) To UBound(xArray, 2)
        If xArray(xHeaderRow, jCol) = xHeaderName Then
            GetArrCol = jCol
            Exit For
        End If
    Next
    If GetArrCol = Empty Then GetArrCol = "Error: Column Header Not Found"
End Function

第1点的一个例子是：

你看到GetArrCol()需要遍历某个2D数组行来查找文本并返回其列索引

这意味着它必须：

切割数组，并获取其中一行
返回某个项目的切片行列索引（如果有）

在这里我们有两个专注于子任务：

谷歌搜索“VBA切片数组”将确保您获得Application.Index()功能

因此您将使用一些Application.Index(myArray, rowIndex, 0)获取myArray行n°rowIndex
谷歌搜索“VBA搜索数组”将确保Application.Match()函数

所以你将使用一些Application.Match(myValue, myArray, 0)来获取myvalue数组中myArray项的列索引，或者错误

结合上述两个发现将导致：

Function GetArrCol(xArray As Variant, xHeaderName As Variant, xHeaderRow As Variant) As Variant
    GetArrCol = Application.Match(xHeaderName, Application.index(xArray, xHeaderRow, 0), 0)
    If IsError(GetArrCol) Then GetArrCol = "Error: Column Header Not Found"
End Function

你必须承认，

比你的克隆代码更短，更清晰，更易于维护

虽然第2点的例子是：

在您的GetArrCol()函数中，您在循环中有以下代码块

    If xArray(xHeaderRow, jCol) = xHeaderName Then
        GetArrCol = jCol
        Exit For
    End If

您可以要求其他功能如下

    Function found(xArray As Variant, xHeaderName As Variant, xHeaderRow As Variant, jCol As Long, GetArrCol As Variant) As Boolean
        found = xArray(xHeaderRow, jCol) = xHeaderName
        If found Then GetArrCol = jCol
    End Function

因此您的主要功能代码将减少到

    Function GetArrCol(xArray As Variant, xHeaderName As Variant, xHeaderRow As Variant) As Variant
        Dim jCol As Long
        For jCol = LBound(xArray, 2) To UBound(xArray, 2)
            If found(xArray, xHeaderName, xHeaderRow, jCol, GetArrCol) Then Exit For
        Next
        If GetArrCol = Empty Then GetArrCol = "Error: Column Header Not Found"
    End Function

最后，我真的应该附上一个Class实现的例子。

但我真的写得太多了......让我们看看你是否想要面对它！

接下来与For with if语句在同一行

2 个答案: