Question

我有以下脚本。我需要在Excel中对27,000行运行它。

输出应在每一行的末尾放入DG列。应该对C列和DF列之间的单元格（108个单元格）中的值进行运算。

Function binning()
Dim rng As Range
Dim str, binStat, temp As String
Dim passes As Integer

Set passes = 0
Set rng = Application.Selection
Set binStat = "High"

For Each cell In rng
    temp = cell.Value

    Select Case temp

    Case "Passed"
        passes = passes + 1
        If passes = 2 Then
            If binStat = "High" Then
                binStat = "Medium"
                passes = 0
            ElseIf binStat = "Medium" Then
                binStat = "Low"
                passes = 0
            ElseIf binStat = "Low" Then
                passes = 0
            End If
        End IF  
    Case "Failed"
        passes = 0
        If binStat = "High" Then
            binStat = "High"
        ElseIf binStat = "Medium" Then
            binStat = "High"
        ElseIf binStat = "Low"  Then
            binStat = "Medium"
        End If  
    End Select
Next cell

binning = binStat
End Function

因此，基本上，它应该在C和DF之间的每一行中运行，并且在DG中根据脚本将其值设置为High，Medium或Low。从工作表的第2行开始。

问题是-我不知道如何在excel 2007中做到这一点。

Answer 1

也许是这样（使用sub而不是function）：

Option Explicit

Sub AssignRowValuesToBins()

    ' Change to whatever your sheet is called. I assume Sheet1.
    With ThisWorkbook.Worksheets("Sheet1")

        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

        Dim arrayOfValues() As Variant
        arrayOfValues = .Range("C2:DG" & lastRow).Value2

        Dim rowIndex As Long
        Dim columnIndex As Long

        Dim binStat As String
        Dim passCount As Long

        Dim writeColumnIndex As Long
        writeColumnIndex = UBound(arrayOfValues, 2)

        For rowIndex = LBound(arrayOfValues, 1) To UBound(arrayOfValues, 1)
            binStat = "High"
            passCount = 0
            For columnIndex = LBound(arrayOfValues, 2) To (writeColumnIndex - 1)
                If AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Passed") Then
                    passCount = passCount + 1
                    If passCount = 2 Then
                        If AreStringsIdentical(binStat, "High") Then
                            binStat = "Medium"
                            passCount = 0
                        ElseIf AreStringsIdentical(binStat, "Medium") Then
                            binStat = "Low"
                            passCount = 0
                        ElseIf AreStringsIdentical(binStat, "Low") Then
                            passCount = 0
                        End If
                    End If
                ElseIf AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Failed") Then
                    passCount = 0
                    If AreStringsIdentical(binStat, "High") Then
                        binStat = "High"
                    ElseIf AreStringsIdentical(binStat, "Medium") Then
                        binStat = "High"
                    ElseIf AreStringsIdentical(binStat, "Low") Then
                        binStat = "Medium"
                    End If
                Else
                    arrayOfValues(rowIndex, writeColumnIndex) = "Unexpected value '" & arrayOfValues(rowIndex, columnIndex) & "'"
                End If
            Next columnIndex
            arrayOfValues(rowIndex, writeColumnIndex) = binStat
        Next rowIndex

        .Range("C2").Resize(UBound(arrayOfValues, 1), UBound(arrayOfValues, 2)).Value2 = arrayOfValues
    End With
End Sub

Private Function AreStringsIdentical(ByVal firstString As String, ByVal secondString As String) As Boolean
    ' Performs case-sensitive comparison.
    AreStringsIdentical = (VBA.Strings.StrComp(firstString, secondString, vbBinaryCompare) = 0)
End Function

我怎样才能对我的Excel工作表的所有行运行我写的VBA？

1 个答案: