在线等待大神的帮忙

Sylar11

具体情况是这样的，有一整列  大概2500个单元格都用到sumif公式，造成了表格运行缓慢，于是想做个VBA按钮，按了之后让那些单元格直接得到值，而不是得到公式，自己也试着摸索了一下Private Sub 按钮01_Click()

    Dim x As Long
    x = WorksheetFunction.SumIf(Range("AB$7:AB$2500"), Range("$A7").Value, Range("AC$7:AC$2500"))
    Range("Z7").Value = x

End Sub


只能写出这样的  但是2500格  我总不能都这样写吧  所以想请各位大神帮帮忙  感谢感谢！

具体案例在附件的Z列

Sylar11

人工置顶  求大神帮忙

france723

Sylar11 发表于 2017-5-18 19:30
人工置顶  求大神帮忙

这是解决你每个都写的问题. 但是使用工作表函数会运算缓慢

1. Sub aaa()
   
2. Dim y, x, i
   
3. y = Range("a65536").End(xlUp).Row
   
4. For i = 7 To y
   
5.     x = WorksheetFunction.SumIf(Range("AB" & i & ":AB" & y), Range("A" & i).Value, Range("AC" & i & ":AC" & y))
   
6.     Cells(i, 26) = x
   
7. Next i
   
8. End Sub

复制代码

327718098

首先指出你的错误，range前面未指定那个工作表，有时候会判断错误

france723

Sylar11 发表于 2017-5-18 19:30
人工置顶  求大神帮忙

数组方法运算快. 按钮如果设置在当前页面, 可以不指定工作表.

1. Sub bbb()
   
2. Dim y, x, i, ar
   
3. y = Sheets("sheet1").Range("a65536").End(xlUp).Row
   
4. ar = Sheets("sheet1").Range("a7:ac" & y)
   
5. For i = 1 To UBound(ar)
   
6. If ar(i, 1) <> "" Then
   
7.     For j = 1 To UBound(ar)
   
8.         If ar(j, 28) = ar(i, 1) Then
   
9.             x = x + ar(j, 29)
   
10.             Cells(i + 6, 26) = x
    
11.         End If
    
12.     Next j
    
13. End If
    
14. Next i
    
15. End Sub

复制代码

Sylar11

france723 发表于 2017-5-18 20:01
数组方法运算快. 按钮如果设置在当前页面, 可以不指定工作表.

大神  这个看不太懂  能加个QQ联系吗

带翅膀老虎

API声明
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'最大路径长度和文件属性常量的定义
Public Const MAX_PATH = 260
'这里有文件属性，包括文件夹、隐藏等
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
'文件结构
Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Sub Main()
    Dim FindData As WIN32_FIND_DATA
    Dim FindHandle As Long
    Dim FindNextHandle As Long
    Dim FPath As String
    Dim FName As String
    Dim FileName1

    Set Dic = CreateObject("Scripting.Dictionary")    '创建本地数组字典对象
    Set Did = CreateObject("Scripting.Dictionary")    '创建本地数组字典对象
    Set objShell = CreateObject("Shell.Application") '创建网络路径对象
    Set objFolder = objShell.BrowseForFolder(0, "选择网络表文根目录", 0, 0) '网络文件夹赋值

      If Not objFolder Is Nothing Then
              lj = objFolder.self.path & "\"     '路径变量赋值
         Else: Exit Sub  '路径变量赋值为空直接退出
      End If

    tms = Timer
    'FPath = ThisWorkbook.Path '本文件所在路径
    FPath = lj
    FName = "*.xls"
     Did.Add (lj), "" '数组路径变量赋值
    i = 0
    Do While i < Did.Count '集合中的数目条目数
        Ke = Did.keys   '开始遍历文件夹字典
    tms = Timer
    ' FPath = ThisWorkbook.path '本文件所在路径

    '开始API查找，找到的文件属性在FindData里
    FindHandle = FindFirstFile(Ke(i) & FName, FindData)
    FileName1 = FindData.cFileName '本文件所在路径
    ' MsgBox FPath & FileName1

    '如果找到，则返回不为0。发生错误返回-1
    If FindHandle <> 0 And FindHandle <> -1 Then
        Do
            FindNextHandle = FindNextFile(FindHandle, FindData)
            FileName1 = FindData.cFileName
            ' MsgBox FPath & FileName1
            If FindNextHandle <> 0 And FindNextHandle <> -1 Then
                If FindData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY Then
                  FileName1 = FindData.cFileName
                  Dic.Add (Ke(i) & FileName1), FileName1    '就往字典中添加这个文件名作为一个条目
                 ' MsgBox FPath & FileName
               ' FindData.cFileName = ""
                Else:


                Did.Add (Ke(i) & FileName1 & "\"), FileName1     '就往字典中添加这个文件夹作为一个条目

                End If
            Else
                Exit Do
            End If
        Loop
    End If
     i = i + 1
        Loop
       FindClose FindHandle  '关闭文件搜索
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name = "XLS文件清单" Then
            Sheets("XLS文件清单").Cells.ClearContents
            f = True
            Exit For
        Else
            f = False
        End If
    Next
    If Not f Then
        Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "XLS文件清单"    '当前工作簿最后创建新工作表
    End If
       aa = UBound(Dic.keys) '查找结果文件名数组界
Sheets("XLS文件清单").[A1].Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.keys) '写入查找含路径结果
Sheets("XLS文件清单").[j1].Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.items()) '文件名已经存在输出
  Sheets("XLS文件清单").[d1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys) '写入查找含路径结果
MsgBox Format(Timer - tms, "0.000s ")
MsgBox i



End Sub
'去除非法字符
Public Function fDelInvaildChr(str As String) As String
    On Error Resume Next
    Dim i As Long
    For i = Len(str) To 1 Step -1
        If Asc(Mid(str, i, 1)) <> 0 And Asc(Mid(str, i, 1)) <> 32 Then
            fDelInvaildChr = Left(str, i)
            Exit For
        End If
    Next
End Function