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

[µo°Ý] Âù°j°é©Î¦h°j°é ¼gªk

[µo°Ý] Âù°j°é©Î¦h°j°é ¼gªk

¥»©«³Ì«á¥Ñ fantersy ©ó 2023-10-4 19:58 ½s¿è

¦U¦ì¥ý¶i¡B¤j¤j¦n
¤p§Ì¦³¤@VBAÂù°j°é°ÝÃD ·Q¤F«Ü¤[³£µLªk¼g¥X¥¿½Tµª®×
¬O§_¤è«K´£¨Ñ¬ÛÃö¼gªk¨Ñ°Ñ¦Ò¾Ç²ß?
VBA°õ¦æ¬yµ{¦p¤U
1.®w¦s¤À­¶§ì¥X¼Æ¾Ú¡A¥u­n­Ü®w½s¸¹¬°JMZ1ªº®Æ¥ó½s¸¹³£¥ýŪ¨ú°_¨Ó¡C
2.¤À­¶axmr450 §ì¨ú¼Æ¾Ú¡AŪ¨ú¬Û¦P®Æ¸¹¨Ã§â¼Æ¶q´î¥hÁ`¥X³f¼Æ¶q¡C(§Ú¥d¦íªº¦a¤è)
3.­q³æ¥¼¥æ¤À­¶¡A±N¦³Åã¥Ü¥X¨Óªº®Æ¸¹CÄæ¦ì¶ñ¤J ¥¼¥æ­q³æ¼Æ¶q
*­q³æ¥¼¥æ¼Æ¶q=axmr450ªºµ²ªG-®w¦sJMZ1ªºµ²ªG
¦³¨Ï¥Î¼Ï¯ÃªºÅÞ¿è¶i¦æÅçºâ¡A¨Ã®M¥Î¦b­q³æ¥¼¥æ¤À­¶(µª®×)¡AÅÞ¿è¥i¥H°Ñ¦Ò¼Ï¯Ã¤À­¶

¤p§ÌªºÅÞ¿è¯uªº¤£¦n¡A·Q¤F¦n¤Ñ³£¼g¤£¥X¨Ó
Àɮפº®e¦³¤p§Ì¼g¨ì¤@¥bªºµ{¦¡»yªk
¯u¤ß·Q¾Ç¦ý¤O¤£±q¤ß¡AÀµ½Ð½ç±Ð
ÁÂÁÂ!!:)
­q³æ¥¼¥æ­pºâ.zip (793.79 KB)

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-10-6 11:15 ½s¿è

¦^´_ 1# fantersy


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

¥H¦r¨å°O¦í­pºâ¥²­n¸ê®Æ,¦A­Ë¥X°µ­pºâ:

Option Explicit
Sub TEST()
Dim Brr, Crr, Drr, Z, i&, T$
Crr = Range([axmr450!R1], [axmr450!A65536].End(3))
Drr = Range([®w¦s!G1], [®w¦s!A65536].End(3))
Brr = Range([­q³æ¥¼¥æ!B3], [­q³æ¥¼¥æ!B65536].End(3))
Set Z = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Drr)
   T = Trim(Drr(i, 5)) & "|" & Trim(Drr(i, 1))
   Z(T) = Z(T) + Val(Drr(i, 6))
Next
For i = 2 To UBound(Crr)
   T = Trim(Crr(i, 7))
   Z(T & "|¼Æ¶q") = Z(T & "|¼Æ¶q") + Val(Crr(i, 10))
   Z(T & "|Á`¥X") = Z(T & "|Á`¥X") + Val(Crr(i, 18))
Next
For i = 1 To UBound(Brr)
   T = Brr(i, 1)
   Brr(i, 1) = Z(T & "|¼Æ¶q") - Z(T & "|Á`¥X") - Z("JMZ1" & "|" & T)
Next
[­q³æ¥¼¥æ!G3].Resize(UBound(Brr), 1) = Brr
Set Z = Nothing: Erase Brr, Drr, Crr
End Sub
==============================
¸É¥R:
½d¨Ò¤¤¦³1¸U¦h­Ó¤£¥i¨£ªº ¤å¦r®Ø©Î¹Ï¤ù....
Sub §R°£ª«¥ó()
With ActiveSheet.DrawingObjects     
   If .Count > 0 Then MsgBox .Count: .Delete
End With
End Sub

============================
¸É¥R¥t¤@¸Ñªk: (¥H¦r¨å°O¦í®Æ¸¹©Ò¦bªº°}¦C¯Á¤Þ¦C¸¹)

Option Explicit
Sub TEST_1()
Dim Brr, Crr, Drr, Z, i&, T$
Crr = Range([axmr450!R1], [axmr450!A65536].End(3))
Drr = Range([®w¦s!G1], [®w¦s!A65536].End(3))
Brr = Range([­q³æ¥¼¥æ!B3], [­q³æ¥¼¥æ!B65536].End(3))
Set Z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Brr): Z(Brr(i, 1)) = i: Brr(i, 1) = 0: Next
For i = 2 To UBound(Crr)
   T = Trim(Crr(i, 7))
   If Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) + Val(Crr(i, 10)) - Val(Crr(i, 18))
Next
For i = 2 To UBound(Drr)
   T = Trim(Drr(i, 1))
   If Trim(Drr(i, 5)) = "JMZ1" And Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) - Val(Drr(i, 6))
Next
[­q³æ¥¼¥æ!G3].Resize(UBound(Brr), 1) = Brr
Set Z = Nothing: Erase Brr, Drr, Crr
End Sub
¬Ý±oÀ´¬OÀ³¸Óªº,À´±oÀ³¥Î¤~¹³¾Ç¥Í,Áy¥Ö«pÂI¾Ç·|§óÂÔ·V¿n·¥

TOP

¦^´_ 2# Andy2483


    ·PÁ¨ó§U»PÀ°¦£
¦³¨Ç»yªk¹ï§Ú¨Ó»¡²¤¬°¦³¨ÇÃø«×
»Ý­n®É¶¡²z¸Ñ¤@¤U
¦A¦¸·PÁÂ

TOP

¦^´_ 3# fantersy


   
¥¼©R¦W.png
2023-10-6 15:45


§Ú¨D¥X¨Óªºµª®×¤£¦P

Sub test()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("­q³æ¥¼¥æ")
s.[G:AZ].ClearContents

q = ""
q = q & "select ²£«~½s¸¹,(¼Æ¶q - Á`¥X³f¼Æ¶q) from [axmr450$A1:T] where ²£«~½s¸¹ in( "
q = q & "select ®Æ¥ó½s¸¹ from [®w¦s$A1:G] where ­Ü®w½s¸¹ like '%JMZ1%' "
q = q & " )"
Set RS = CN.Execute(q)
s.[G3].CopyFromRecordset RS

q = ""
q = q & "select ²£«~½s¸¹,sum(dif) from ("
q = q & "select ²£«~½s¸¹,(¼Æ¶q - Á`¥X³f¼Æ¶q) as dif from [axmr450$A1:T] where ²£«~½s¸¹ in( "
q = q & "select ®Æ¥ó½s¸¹ from [®w¦s$A1:G] where ­Ü®w½s¸¹ like '%JMZ1%' "
q = q & " ) "
q = q & " ) group by ²£«~½s¸¹"
Set RS = CN.Execute(q)
s.[J3].CopyFromRecordset RS

q = ""
q = q & "select t3.®Æ¸¹,t3.®Æ¸¹¼ÆÁ`©M from  ( "
q = q & "select * from [­q³æ¥¼¥æ$B2:B] as t1 left join ( "
q = q & "select ²£«~½s¸¹,sum(dif) as ®Æ¸¹¼ÆÁ`©M from ( "
q = q & "select ²£«~½s¸¹,(¼Æ¶q - Á`¥X³f¼Æ¶q) as dif from [axmr450$A1:T] where ²£«~½s¸¹ in( "
q = q & "select ®Æ¥ó½s¸¹ from [®w¦s$A1:G] where ­Ü®w½s¸¹ like '%JMZ1%' "
q = q & " ) "
q = q & " ) group by ²£«~½s¸¹ "
q = q & " ) as t2 on t1.®Æ¸¹ = t2.²£«~½s¸¹ "
q = q & " ) as t3"
Set RS = CN.Execute(q)
s.[M3].CopyFromRecordset RS

s.[G2:N2] = Array("axmr©Ò¦³", "³v¶µ®t¼Æ", "", "¦X¨Ö", "¥¼¥æÁ`¼Æ", "", "¹ï·Ó¥¼¥æ", "¥¼¥æ¼Æ")
End Sub

­q³æ¥¼¥æ­pºâ.zip (798.13 KB)

TOP

¦^´_ 4# singo1232001


Á×§K¹L©óµ{§Ç¹Lªøºë²
Sub test2ºë²ª©()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("­q³æ¥¼¥æ"): s.[C3:C9999].ClearContents
q = "select t2.®Æ¼Æ©M from [­q³æ¥¼¥æ$B2:B] as t1 left join ( "
q = q & "select ²£«~½s¸¹,IIf(IsNull(sum(dif)), 0, sum(dif)) as ®Æ¼Æ©M from ( "
q = q & "select ²£«~½s¸¹,(¼Æ¶q - Á`¥X³f¼Æ¶q) as dif from [axmr450$A1:T] where ²£«~½s¸¹ in( "
q = q & "select ®Æ¥ó½s¸¹ from [®w¦s$A1:G] where ­Ü®w½s¸¹ like '%" & s.[c1] & "%' "
q = q & " ) "
q = q & " ) group by ²£«~½s¸¹ "
q = q & " ) as t2 on t1.®Æ¸¹ = t2.²£«~½s¸¹ "
s.[c3].CopyFromRecordset CN.Execute(q)
End Sub

------------------------------------------------------
Sub test3³v¨B±À¶iºë²ª©()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("­q³æ¥¼¥æ"): s.[G:AZ].ClearContents

    q = "select ²£«~½s¸¹,(¼Æ¶q - Á`¥X³f¼Æ¶q) as dif from [axmr450$A1:T] where ²£«~½s¸¹ in( "
q = q & "select ®Æ¥ó½s¸¹ from [®w¦s$A1:G] where ­Ü®w½s¸¹ like '%" & s.[c1] & "%' "
p = q & " ) "
s.[G3].CopyFromRecordset CN.Execute(p)

    q = "select ²£«~½s¸¹,IIf(IsNull(sum(dif)), 0, sum(dif)) as ®Æ¼Æ©M from ( " & p
p = q & " ) group by ²£«~½s¸¹ "
s.[J3].CopyFromRecordset CN.Execute(p)

    q = "select t1.®Æ¸¹,t2.®Æ¼Æ©M  from [­q³æ¥¼¥æ$B2:B] as t1 left join ( " & p
p = q & " ) as t2 on t1.®Æ¸¹ = t2.²£«~½s¸¹ "
s.[M3].CopyFromRecordset CN.Execute(p)

s.[G2:N2] = Array("axmr©Ò¦³", "³v¶µ®t¼Æ", "", "¦X¨Ö", "¥¼¥æÁ`¼Æ", "", "¹ï·Ó¥¼¥æ", "¥¼¥æ¼Æ")
End Sub


¥i¦bC1¿é¤J¬d¸ß½s¸¹
­q³æ¥¼¥æ­pºâ v1.zip (802.92 KB)

TOP

¦^´_ 3# fantersy


    ÁÂÁ«e½ú¦^´_
¥H¤U¬O½Æ²ß¤ß±oµù¸Ñ,½Ð«e½ú°Ñ¦Ò

Sub TEST_1()
Dim Brr, Crr, Drr, Z, i&, T$
'¡ô«Å§iÅܼÆ:(Brr, Crr, Drr, Z)¬O³q¥Î«¬ÅܼÆ,i¬Oªø¾ã¼Æ,T¬O¦r¦êÅܼÆ
Crr = Range([axmr450!R1], [axmr450!A65536].End(3))
'¡ô¥OCrrÅܼƬO¤Gºû°}¦C,¥H"axmr450"¤u§@ªí[R1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ­È±a¤J
Drr = Range([®w¦s!G1], [®w¦s!A65536].End(3))
'¡ô¥ODrrÅܼƬO¤Gºû°}¦C,¥H "®w¦s"¤u§@ªí[G1]¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ­È±a¤J
Brr = Range([­q³æ¥¼¥æ!B3], [­q³æ¥¼¥æ!B65536].End(3))
'¡ô¥OBrrÅܼƬO¤Gºû°}¦C,¥H "­q³æ¥¼¥æ"¤u§@ªí[B3]¨ìBÄæ³Ì«á¦³¤º®eÀx¦s®æ­È±a¤J
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO¦r¨å
For i = 1 To UBound(Brr): Z(Brr(i, 1)) = i: Brr(i, 1) = 0: Next
'¡ô³]¶¶°j°é!±q1¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
'¥Oi°j°é¦C²Ä1ÄæBrr°}¦C­È·íkey,item¬OiÅܼÆ,¯Ç¤JZ¦r¨å¤¤
'¥Oi°j°é¦C²Ä1ÄæBrr°}¦C­È=0

For i = 2 To UBound(Crr)
'¡ô³]¶¶°j°é!±q1¨ìCrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   T = Trim(Crr(i, 7))
   '¡ô¥OTÅܼƬO ¥h°£ÀY§ÀªÅ¥Õ¦r¤¸(i°j°é¦C²Ä7ÄæCrr°}¦C­È)ªº¦r¦ê
   If Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) + Val(Crr(i, 10)) - Val(Crr(i, 18))
   '¡ô¦pªG¥HTÅܼƬdZ¦r¨å¦^¶Çitem­È¤£¬OªÅ¦r¤¸!
   '´N¥OTÅܼƬdZ¦r¨å¦^¶Çitem(­ìTÅܼƦbBrr°}¦C©Ò¦bªº¦C¸¹)
   '¥O¸Ó¦C¸¹²Ä1ÄæBrr°}¦C­È+Val¨ç¼Æ­È(i°j°é¦C10ÄæCrr°}¦C­È)-Val¨ç¼Æ­È(i°j°é¦C18ÄæCrr°}¦C­È)

Next
For i = 2 To UBound(Drr)
   T = Trim(Drr(i, 1))
   '¡ô¥OTÅܼƬO ¥h°£ÀY§ÀªÅ¥Õ¦r¤¸(i°j°é¦C²Ä1ÄæDrr°}¦C­È)ªº¦r¦ê
   If Trim(Drr(i, 5)) = "JMZ1" And Z(T) <> "" Then Brr(Z(T), 1) = Brr(Z(T), 1) - Val(Drr(i, 6))
   '¡ô¦pªGi°j°é¦C²Ä5ÄæDrr°}¦C­È¸g¥h°£ÀY§ÀªÅ¥Õ¦r¤¸«áªº¦r¦ê="JMZ1"!
   '¦Ó¥B¥HTÅܼƬdZ¦r¨å¦^¶Ç­È¤£¬OªÅ¦r¤¸!
   '´N¥OTÅܼƬdZ¦r¨å¦^¶Çitem(­ìTÅܼƦbBrr°}¦C©Ò¦bªº¦C¸¹)
   '¥O¸Ó¦C¸¹²Ä1ÄæBrr°}¦C­È-Val¨ç¼Æ­È(i°j°é¦C6ÄæDrr°}¦C­È)

Next
[­q³æ¥¼¥æ!G3].Resize(UBound(Brr), 1) = Brr
'¡ô¥O"­q³æ¥¼¥æ"¤u§@ªí[G3]¦V¤UÂX®i Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¸¹¦Cªº½d³òÀx¦s®æ­È¥HBrr°}¦C±a¤J
Set Z = Nothing: Erase Brr, Drr, Crr
'¡ôÄÀ©ñÅܼÆ
End Sub
¬Ý±oÀ´¬OÀ³¸Óªº,À´±oÀ³¥Î¤~¹³¾Ç¥Í,Áy¥Ö«pÂI¾Ç·|§óÂÔ·V¿n·¥

TOP

¦^´_ 5# singo1232001


    ÁÂÁ¤j¤jªºÀ°¦£

TOP

        ÀR«ä¦Û¦b : ¡i¬°µ½Ävª§¡j¤H¥Í­n¬°µ½Ävª§¡A¤À¬í¥²ª§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD