Как я могу запустить VBA, которую я написал для всех строк моего листа Excel? - PullRequest
Новая
       46

Как я могу запустить VBA, которую я написал для всех строк моего листа Excel?

0 голосов
/ 12 ноября 2018

У меня есть следующий скрипт.Мне нужно запустить его против 27 000 строк в Excel.

Вывод должен быть помещен в столбец 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,Средний или Низкий в зависимости от сценария.Начинается со строки 2 листа.

Проблема в том, что я не знаю, как это сделать в Excel 2007.

1 Ответ

0 голосов
/ 12 ноября 2018

Может быть что-то вроде этого (использует sub, а не функцию): 

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
...