Question

我正在用excel编写vb脚本，这是我的问题。

我有20多个Excel工作表和一个主要工作表（所有具有200个名称的程序）。每个工作表都有一个列，其中包含名称和24个月（1月18日至12月18日，1月19日至12月20日）。每个工作表名称都是主工作表的子集

主表（所有程序）具有200个名称和24个月（该值将根据其他表进行计算）
其他工作表具有每月对应于主工作表的名称和值

我需要在主工作表中使用每个名称，然后在所有其他工作表中搜索该名称（如果存在），将所有相同的列值相加并插入主工作表中。

对于1个名称，我需要对34个单元格进行计算（对于200个名称* 34个单元格= 6800个单元格）。我上面的代码花了将近20分钟。我还有其他方法可以使用它，也可以进行任何修改来提高性能吗？

下面是我的代码和示例

谢谢。

示例：

主表的名称为“ employee1”

Sheet1

Sheet2

应根据月份计算主表上的值

Dim sheetCount As Integer
Dim datatoFind
Private Sub CommandButton1_Click()
    Dim mainSheet As String: mainSheet = "All Programs"
    Dim nameColumnStart As String: nameColumnStart = "A"

    Dim namesStart As Integer: namesStart = 1
    Dim namesEnd As Integer: namesEnd = 200

    Dim startColumn As Integer: startColumn = 10 'J Column'
    Dim EndColumn As Integer: EndColumn = 33 'AG Column'

    namesStart = InputBox("Please enter start value")
    namesEnd = InputBox("Please enter end value")


    Dim temp_str As String
    Dim total As Single
    On Error Resume Next
    Sheets(mainSheet).Activate
    lastRow_main = ActiveCell.SpecialCells(xlLastCell).Row
    lastCol_main = 34
    For vRow = namesStart To namesEnd
        temp_str = Sheets(mainSheet).Cells(vRow, "A").Text
        datatoFind = StrConv(temp_str, vbLowerCase)
            For vCol = startColumn To EndColumn
                total = Find_Data(vCol)
                Worksheets(mainSheet).Cells(vRow, vCol).Value = total
            Next vCol
    Next vRow
    Sheets(mainSheet).Activate
    'MsgBox ("Calculated all values")'
End Sub


Private Function Find_Data(ByVal ColumnName As Integer) As Single
    Dim counter As Integer
    Dim currentSheet As Integer
    Dim sheetCount As Integer
    Dim str As String
    Dim lastRow As Long
    Dim lastCol As Long
    Dim val As Single

    Find_Data = 0

    currentSheet = ActiveSheet.Index

    If datatoFind = "" Then Exit Function

    sheetCount = ActiveWorkbook.Sheets.Count

    For counter = 2 To sheetCount

        Sheets(counter).Activate

        lastRow = ActiveCell.SpecialCells(xlLastCell).Row
        lastCol = ActiveCell.SpecialCells(xlLastCell).Column

        For vRow = 1 To lastRow
                str = Sheets(counter).Cells(vRow, "A").Text
                If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then
                        val = Sheets(counter).Cells(vRow, ColumnName).Value
                        Find_Data = Find_Data + val
                End If
        Next vRow

    Next counter

End Function

Answer 1

为什么不在一张纸上而不是在另一张纸上收集数据？
代替工作表，在A列中使用过滤器！

然后使用数据透视表汇总所有内容！
计算以秒为单位！

Answer 2

请尝试替换此代码：

For vRow = namesStart To namesEnd
    temp_str = Sheets(mainSheet).Cells(vRow, "A").Text
    datatoFind = StrConv(temp_str, vbLowerCase)
        For vCol = startColumn To EndColumn
            total = Find_Data(vCol)
            Worksheets(mainSheet).Cells(vRow, vCol).Value = total
        Next vCol
Next vRow

使用：

With Sheets(mainSheet)

    For vRow = namesStart To namesEnd
        temp_str = .Cells(vRow, "A").Text
        datatoFind = StrConv(temp_str, vbLowerCase)
        For vCol = startColumn To EndColumn
            total = Find_Data(vCol)
            .Cells(vRow, vCol).Value = total
        Next vCol
    Next vRow

End With

这段代码：

    For vRow = 1 To lastRow
            str = Sheets(counter).Cells(vRow, "A").Text
            If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then
                    val = Sheets(counter).Cells(vRow, ColumnName).Value
                    Find_Data = Find_Data + val
            End If
    Next vRow

替换为：

    With Sheets(counter)

        For vRow = 1 To lastRow
            str = .Cells(vRow, "A").Text
            If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then
                val = .Cells(vRow, ColumnName).Value
                Find_Data = Find_Data + val
            End If
        Next vRow

    End With

VB Script for Excel需要很长时间才能计算值

2 个答案: