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

[µo°Ý] ½Ð°ÝVBA¥i¥H¿z¿ï«á¡A¹ï¨äµ²ªG¦A¶i¦æ¶i¶¥¿z¿ï¶Ü?

¦^´_ 1# iceandy6150

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr(), xD, T1, T4$, ND As Date, i&, j%,n%
Set xD = CreateObject("Scripting.Dictionary")
ND = InputBox("½Ð¿é¤J¤é´Á¡G", "¤é´Á", "2021/1/1")
Arr = Range([e1], [a65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1): T4 = Arr(i, 4)
    If ND = T1 And xD(T4) = "" Then
        n = n + 1: xD(T4) = n
        For j = 1 To 5: Brr(n, j) = Arr(i, j): Next
        xD(ND & "/1") = xD(ND & "/1") + Arr(i, 5)
    End If
Next
[u1].CurrentRegion = ""
If n > 0 Then
    Range("a1:f1").Copy [u1]
    Range("u2").Resize(n, 5) = Brr
    Range("x" & n + 2) = n
    Range("y" & n + 2) = xD(ND & "/1")
Else
    MsgBox "µL¸ê®Æ"
End If
End Sub

TOP

¦^´_  samwang


samwang¤j¤j¡A¥i¥H¨Ï¥Î
·PÁ§A

¦pªG§A¤è«Kªº¸Ü
¥i¥H¤U¤@¨Çµù¸Ñ¶Ü?  
¹ï©ó¦r¨å ÁÙ ...
iceandy6150 µoªí©ó 2021-11-30 15:37


Sub test()
Dim Arr, Brr(), xD, T1, T4$, ND As Date, i&, j%, n%
Set xD = CreateObject("Scripting.Dictionary")
ND = InputBox("½Ð¿é¤J¤é´Á¡G", "¤é´Á", "2021/1/1") '»Ý¨D¤é´Á
Arr = Range([e1], [a65536].End(3))  '¸ê®Æ¸Ë¤JArr¼Æ²Õ
ReDim Brr(1 To UBound(Arr), 1 To 5) '²Å¦X»Ý¨DªºBrr¼Æ²Õ
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1): T4 = Arr(i, 4)
    If ND = T1 And xD(T4) = "" Then '¦³²Å¦X¤é´Á¥B°Ó«~¦WºÙ¤£­«½Æ
        n = n + 1: xD(T4) = n       '²Î­p°Ó«~¤£­«½Æ¼Æ¶q
        For j = 1 To 5: Brr(n, j) = Arr(i, j): Next  '²Å¦X¸ê®Æ¸Ë¨ìBrr¼Æ²Õ
        xD(ND & "/1") = xD(ND & "/1") + Arr(i, 5)    '²Î­p¼Æ¶q¸Ë¦r¨å
    End If
Next
[u1].CurrentRegion = "" '²M°£
If n > 0 Then
    Range("a1:f1").Copy [u1]            'copy©ïÀY
    Range("u2").Resize(n, 5) = Brr      '¶×¥XBrr
    Range("x" & n + 2) = n              '¶×¥X²Î­p°Ó«~¤£­«½Æ¼Æ¶q
    Range("y" & n + 2) = xD(ND & "/1")  '¶×¥X²Î­p¼Æ¶q
Else
    MsgBox "µL¸ê®Æ"
End If
End Sub

TOP

        ÀR«ä¦Û¦b : ¬O«D·í±Ð¨|¡AÆg¬ü§@ĵ±§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD