ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] EXCEL VBA ¤é´Á°Ï¶¡¦p¦ó²Î­p

[µo°Ý] EXCEL VBA ¤é´Á°Ï¶¡¦p¦ó²Î­p

½Ð±Ð¦U¦ì«e½ú,¤é´Á°Ï¶¡¦p¦ó²Î­p,ÁÂÁÂ. ¤é´Á²Î­p.rar (29.19 KB)
§ù¤p¥­

  1. Sub zz()
  2. Dim a, da As Date, dz As Date, dx As Date, n&, s$
  3. Dim d As Object, m!
  4. Set d = CreateObject("scripting.dictionary")
  5. a = Sheets(1).[a1].CurrentRegion.Value
  6. With Sheets(2)
  7.     da = .[l2].Value: dz = .[l3].Value
  8.     For i = 2 To UBound(a)
  9.         dx = a(i, 7)
  10.         If dx >= da And dx <= dz Then
  11.             m = m + a(i, 4)
  12.             n = n + 1
  13.             s = a(i, 5) & "(" & a(i, 6)
  14.             d(s) = d(s) + a(i, 4)
  15.             For j = 1 To 8
  16.                 a(n, j) = a(i, j + 1)
  17.             Next
  18.         End If
  19.     Next
  20.     .[a1].CurrentRegion.Offset(1).Clear
  21.     .[a2].Resize(n, 8) = a
  22.     .[a2].Resize(n, 8).Borders.Value = 1
  23.     .Cells(n + 2, 2).Resize(1, 2) = Array("Total", m)
  24.     For Each k In d.keys
  25.         n = n + 1
  26.         .Cells(n + 1, "d") = k & d(k) & "¥ó)"
  27.     Next
  28. End With
  29. End Sub
½Æ»s¥N½X

TOP

·PÁÂikboy«e½ú¦^ÂÐ,°õ¦æ¤¤,°±¯d¦b¶À¼Ð¤W,½Ðikboy«ü¾É,ÁÂÁÂ.
§ù¤p¥­

TOP

1111

¤é´Á²Î­p.jpg
2020-10-21 15:00
§ù¤p¥­

TOP

ikboy©êºp,§Ú¦Û¤v¾Þ§@¿ù»~,¥i¥H¨Ï¥Î¤F,¨ä¥L§Ú¦Û¦æ­×¹¢,·P®¦.
§ù¤p¥­

TOP

ÀH·NºÛ "EXCEL°g"  blog  ©Îhttps://hcm19522.blogspot.com/ EXCEL¨ç¼Æ

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°ÝÃD/±ø¥ó/°õ¦æ«e:
20231227_1.jpg
2023-12-27 14:43


¸ê®Æªí:
20231227_2.jpg
2023-12-27 14:43


°õ¦æµ²ªG:
20231227_3.jpg
2023-12-27 14:44


Option Explicit
Sub TEST()
Dim Brr, Z, i&, j%, R&, °_©l¤é As Date, µ²§ô¤é As Date, xR As Range
Set Z = CreateObject("Scripting.Dictionary")
[²Î­pªí!A1].CurrentRegion.Offset(1, 0).ClearContents
°_©l¤é = [²Î­pªí!L2]: µ²§ô¤é = [²Î­pªí!L3]
Brr = Range([¤u§@ªí1!I1], [¤u§@ªí1!A65536].End(3))
For i = 2 To UBound(Brr)
   If Brr(i, 7) < °_©l¤é Or Brr(i, 7) > µ²§ô¤é Then GoTo i01 Else R = R + 1
   For j = 2 To 9: Brr(R, j - 1) = Brr(i, j): Next
   Z(Brr(i, 5) & "/" & Brr(i, 6)) = Z(Brr(i, 5) & "/" & Brr(i, 6)) + Val(Brr(i, 4))
i01: Next
If R = 0 Then Exit Sub
With [²Î­pªí!A2].Resize(R, 8)
   .Value = Brr
   .Cells(.Count + 2) = "Total"
   .Cells(.Count + 3) = "=SUM(" & .Columns(3).Address & ")"
   Set xR = .Cells(.Count + 4)
End With
For i = 0 To Z.Count - 1: Brr(i + 1, 1) = Z.keys()(i): Brr(i + 1, 2) = Z.items()(i): Next
xR.Resize(Z.Count, 2) = Brr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

(¿é¤J½s¸¹12196) googleºô§}:https://hcm19522.blogspot.com/
ÀH·NºÛ "EXCEL°g"  blog  ©Îhttps://hcm19522.blogspot.com/ EXCEL¨ç¼Æ

TOP

Sub test()
i = Split("Provider=Microsoft.,Jet.OLEDB.4,.0;Extended Properties=Excel ,8,.0;Data Source=", ",")
If Application.Version > 12 Then i(1) = "ACE.OLEDB.12": i(3) = 12
Set cn = CreateObject("adodb.connection"): cn.Open Join(i, "") & ThisWorkbook.FullName
Set s = Sheets("²Î­pªí"): s.[A:I].ClearContents
Set s1 = Sheets("¤u§@ªí1"):
ar = Application.Index(s1.[a1:i1].Value, 1, 0)
s1.[a1:i1].ClearContents
q = "select F2,F3,F4,F5,F6,F7,F8,F9 from[¤u§@ªí1$a1:J]where format(F7,""yyyy-MM-dd"")between'"
q = q & Format(s.[L2], "yyyy-MM-dd") & "'and'" & Format(s.[L3], "yyyy-MM-dd") & " 23:59:59'"
q = q & "order by F6,F7 asc"
s.[a2].CopyFromRecordset cn.Execute(q)
s.[a1:h1] = Split(Mid(Join(ar, ";;"), 7, 999), ";;")
s1.[a1:i1] = ar
End Sub

TOP

        ÀR«ä¦Û¦b : µÊ®ð¼L¤Ú¤£¦n¡A¤ß¦a¦A¦n¤]¤£¯àºâ¬O¦n¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD