¶×¾ã¸ê®Æ

fangsc

½Ð±Ð
sheet2°µ¤F¤@¥÷¼Ï¯Ã¿z¿ï,¦A±N¿z¿ï«áªº¸ê®Æ¨Ì²£«~¦WºÙ+©m¦Wªº²Ö¥[ÁʶR¼Æ¶q©ñ¤Jsheet4
¤£ª¾¬°¦ó¶]¥X¨ÓªºÁʶR¼Æ¶q¬Ò¬°0
½Ð±Ð¦p¦ó­×§ï¥H¤Uµ{¦¡

i = 1
Do
    If sheet4.Cells(i + 1, "a") & sheet4.Cells(i + 1, "b").Text = sheet2.Cells(4, "n").Text Then
    sheet4.Cells(i + 1, "d") = sheet2.Cells(4, "o")
    ElseIf sheet4.Cells(i + 1, "a") & sheet4.Cells(i + 1, "b").Text <> sheet2.Cells(4, "m") Then
    sheet4.Cells(i + 1, "d") = 0
    End If

i = i + 1
Loop Until Cells(i, "a") = ""
End sub

jcchiang

¦^´_ 1# fangsc

¸Õ¸Õ¬Ý!
±N"N90122Áʳf©ú²Ó¶K¤W"¤º²Å¦X"µÒ¬["¤º¦W³æ&²£«~¥N¸¹"1"¶}ÀYªº¼Æ¶q°µ²Î­p
Sub ex()
Dim d As Object
Dim arr As Object
Dim x%, AA$
Set d = CreateObject("Scripting.Dictionary")
Set arr = Sheets("N90122Áʳf©ú²Ó¶K¤W").[a1].CurrentRegion
For x = 2 To arr.Rows.Count
   AA = arr(x, 3) & "-" & Left(arr(x, 1), 1)
   If Not d.exists(AA) Then
      d.Add AA, arr(x, 6)
   Else
      d(AA) = d(AA) + arr(x, 6)
   End If
Next
Set arr = Sheets("µÒ¬[").[a1].CurrentRegion
For x = 2 To arr.Rows.Count
   For Each a In d
     If a = arr(x, 1) & arr(x, 2) & "-1" Then arr(x, 4) = d(a): GoTo Line1
   Next
   arr(x, 4) = 0
Line1:
Next
End Sub

fangsc

¦^´_ 2# jcchiang

·PÁ±zªº¸ÑÃD. ¶W¥X§Ú¥i¥H²z¸Ñµ{«×ªº¼gªk.
1. ¥i¥H¨D¤@­Ó¤ñ¸ûªì¶¥µ{«×ªº¼gªk¶Ü¡H
2. ¥t¥~¸É¥R : µ²ªG¼Æ¦r­n °£10

jcchiang

¦^´_ 3# fangsc


³o¬q¥[­Ó°£10´N¥i¥H
    If a = arr(x, 1) & arr(x, 2) & "-1" Then arr(x, 4) = d(a) / 10: GoTo Line1
¦Ü©ó¤ñ¸ûªì¶¥µ{«×¤£¤F¸Ñ¬O¦p¦ó

fangsc

¦^´_ 4# jcchiang
·PÁ±z.

­ã´£³¡ªL

Sub TEST_A1()
Dim Arr, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([N90122Áʳf©ú²Ó¶K¤W!J1], [N90122Áʳf©ú²Ó¶K¤W!A65536].End(xlUp))
For i = 2 To UBound(Arr)
    If Left(Arr(i, 1), 1) <> "1" Then GoTo i01
    xD(Arr(i, 3)) = xD(Arr(i, 3)) + Val(Arr(i, 6)) / 10
i01: Next i
Arr = Range([µÒ¬[!B2], [µÒ¬[!A65536].End(xlUp))
For i = 1 To UBound(Arr)
    Arr(i, 1) = xD(Arr(i, 1) & Arr(i, 2))
Next i
[µÒ¬[!D2].Resize(UBound(Arr), 1) = Arr
End Sub

fangsc

¦^´_ 6# ­ã´£³¡ªL

·PÁª©¥D«ü¾É.

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

¸ê®Æªí:

¤U¸ü (300.04 KB)

2023-6-6 16:19

µ²ªGªí°õ¦æ«e:

¤U¸ü (126.32 KB)

2023-6-6 16:16

°õ¦æµ²ªG:

¤U¸ü (132.03 KB)

2023-6-6 16:16

Option Explicit
Sub TEST()
Dim Brr, Crr, Y, T$, T1$, V&, i&, Sh1 As Worksheet, Sh2 As Worksheet
'¡ô«Å§iÅܼÆ
Set Sh1 = Sheets("N90122Áʳf©ú²Ó¶K¤W"): Set Sh2 = Sheets("µÒ¬[")
'¡ô¥OÅܼƸˤJª«¥ó(¤u§@ªí)
Set Y = CreateObject("Scripting.Dictionary")
'¡ôYÅܼƬO ¦r¨å
Brr = Range(Sh1.[J1], Sh1.Cells(Rows.Count, 1).End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HA~JÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
   T1 = Brr(i, 1): T = Brr(i, 3): V = Brr(i, 6)
   '¡ô¥OT1ÅܼƬO ²Ä1Äæ°}¦C­È(¦r¦ê),¥OTÅܼƬO ²Ä3Äæ°}¦C­È(¦r¦ê),
   '¥OVÅܼƬO ²Ä6Äæ°}¦C­È(¼Æ­È)
   If InStr(T1, "1") = 1 Then Y(T) = Y(T) + V / 10
   '¡ô¦pªGT1ÅܼƲÄ1­Ó¦r¬O 1?
   '¬O´N¥O¦bY¦r¨å¸ÌªºTÅܼÆkey¨äitem²Ö¥[(VÅܼư£10)ªº¼Æ­È
Next i
Brr = Range(Sh2.[B2], Sh2.Cells(Rows.Count, 1).End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,´«¥HA~BÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Crr(1 To UBound(Brr), 1 To 1)
'¡ô¥OCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V1~1
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
    Crr(i, 1) = Val(Y(Brr(i, 1) & Brr(i, 2)))
    '¡ô¥OCrr°}¦C­È¬O ²Ä1ÄæBrr°}¦C­È³s±µ²Ä2ÄæBrr°}¦C²Õ¦¨ªº·s¦r¦ê,¬d
    '¬dY¦r¨å±o¨ìªºitem­È¦AÂà¤Æ¬°¼Æ­Èªº­È(¸É0)
Next i
Sh2.[E2].Resize(UBound(Crr)) = Crr
'¡ô¥Oµ²ªGªí±q[E2]¶}©l½d³òÀx¦s®æ¥HCrr°}¦C­È¼g¤J
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub