公式转换成VBA中的代码

张韶均

哪位高速帮忙

3190496160

Sub 筛选数据()
Application.ScreenUpdating = False
Dim ar As Variant
Dim br()
With Sheets("粘贴区")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 3 Then MsgBox "粘贴区为空！": End
    ar = .Range("a2:d" & r)
End With
With Sheets("复制区")
    sj = .[f1]
    With .UsedRange.Offset(2)
        .ClearContents
        .Borders.LineStyle = 0
    End With
    ReDim br(1 To UBound(ar), 1 To 5)
    For i = 2 To UBound(ar)
        If ar(i, 4) <> "" Then
            If ar(i, 4) = sj Then
                n = n + 1
                br(n, 1) = n
                br(n, 2) = ar(i, 3)
                br(n, 3) = ar(i, 2)
                br(n, 4) = ar(i, 4)
                br(n, 5) = ar(i, 1)
            End If
        End If
    Next i
    If n = "没有符合条件的数据！" Then MsgBox "": End
    .[a3].Resize(n, UBound(br, 2)) = br
    .[a3].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

公式转换成VBA中的代码.rar (30.13 KB, 下载次数: 24)

2025-3-22 10:25 上传

点击文件名下载附件

baofa2

1. Sub test1() '
   
2.   Dim conn As Object, SQL As String
   
3.   Sheet17.Activate
   
4.   ActiveSheet.UsedRange.Offset(2, 1).ClearContents
   
5.   Set conn = CreateObject("ADODB.Connection")
   
6.   conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=NO';Data Source=" & ThisWorkbook.FullName
   
7.   SQL = "SELECT F3,SUM(F2),F4,F1 FROM (SELECT * FROM [粘贴区$A3:D] WHERE F4='" & Range("F1").Value & "') GROUP BY F3,F4,F1"
   
8.   Range("B3").CopyFromRecordset conn.Execute(SQL)
   
9.   conn.Close
   
10.   Set conn = Nothing
    
11.   Beep
    
12. End Sub

复制代码

张韶均

3190496160 发表于 2025-3-22 10:26

数量不能自动统计

3190496160

张韶均 发表于 2025-3-22 16:58
数量不能自动统计

先学会说声谢谢，再说吧

张韶均

3190496160 发表于 2025-3-22 17:06
先学会说声谢谢，再说吧

谢谢高手

凌空一羽

公式转换成VBA中的代码.zip (21.11 KB, 下载次数: 22)

2025-3-22 19:08 上传

点击文件名下载附件

3190496160

公式转换成VBA中的代码.rar (30.14 KB, 下载次数: 19)

2025-3-22 19:44 上传

点击文件名下载附件

ykcbf1100

参与一下。。。