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

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

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

¥»©«³Ì«á¥Ñ iceandy6150 ©ó 2021-11-29 23:25 ½s¿è

¤j®a¦n
·Q½Ð°ÝVBA¦³¨S¦³¿ìªk°µ¨ì
¿z¿ï«á¡A¥X¨Óªºµ²ªG¡A¦b°µ¶i¶¥¿z¿ï?

¥H¤U¨Ò¤l
§Ú·Q°µ¨ì¥ý¿z¿ï¥X2021/11/23ªº¶µ¥Ø
¬Ý¬ÝÁ`¦@´X­Ó²Å¦X (¬õ¦â)

µM«á°w¹ï°Ó«~¥h¶i¦æ"¶i¶¥¿z¿ï" (ºñ¦â)  ¤£­«½Æ
³Ì«á¬O§â¦UºØ°Ó«~ªºÁ`¼Æ¶q¥[°_¨Ó (ÂŦâ)

¥\¯à»Ý¨D¡G
§Ú­n°µ¤@­Ó¬d¸ß¥\¯à¡A¨Ï¥ÎªÌ³z¹LInputbox¡Aµ¹§Ú¦~¤ë¤é
§Ú­n±q«Ü¦h«Ü¦h¸ê®Æ¤¤
¥ý¿z¿ï¥X·í¤Ñ¤é´Áªº¸ê®Æ¡AµM«á¤ÀªR·í¤ÑÁ`¦@¦³¦h¤ÖºØÃþªº²£«~¡A¥[Á`¦U²£«~ªº¼Æ¶q
(¦³ÂIÃþ¦ü¼Ï¯Ã¤ÀªR)

¦A½Ð¦U¦ì«ü¾É¡AÁÂÁÂ
¿z¿ï«á¦A¶i¶¥¿z¿ï.jpg
2021-11-29 23:18


´ú¸Õ¿z¿ï¨Ã½Æ»s¯S©w½d³ò.rar (29.08 KB)
(«ö¶s¤T)
  1. Private Sub CommandButton3_Click()

  2. Dim i
  3. Dim a
  4. Dim Sg As Range


  5. i = Sheets("¤u§@ªí2").Cells(1, 9).Value
  6. a = Sheets("¤u§@ªí2").Columns(2).End(xlDown).Row

  7. Dim Rng As Range        '¿z¿ïµ²ªG½d³ò

  8.     With Sheets("¤u§@ªí2")       '¦b¤u§@ªí2¤¤
  9.         Set Rng = .UsedRange.Range("A1:F" & a)  '©Ò¦³¸ê®Æ½d³ò¤¤ªºA1~F©³
  10.         Rng.AutoFilter Field:=1, Criteria1:="2021/11/23"
  11.         
  12.         Set fa = [d2:d65536].SpecialCells(xlCellTypeVisible)(1)
  13.         Set fb = [D65536].End(xlUp)
  14.         
  15.         If fa = "" Then
  16.             MsgBox "¬dµL¸ê®Æ"
  17.             Sheets("¤u§@ªí2").Range("A:E").AutoFilter
  18.             Exit Sub
  19.         End If
  20.         
  21.         Set Sg = .Range("A" & fa.Row & ":F" & fb.Row)
  22.         '¡´·Q°w¹ï­è­è¿z¿ï¥X¨Óªº½d³ò  ¶i¦æ  ¶i¶¥¿z¿ï¤£­«½Æ  ©ñ¨ìK1
  23.         Sg.AdvancedFilter xlFilterCopy, .Range("D:D"), Sheets("¤u§@ªí2").Range("K1"), True
  24.    End With
  25. End Sub
½Æ»s¥N½X
³Ì«á¦A¥Î Application.SumIfs ¥h¥[Á`¦UºØÃþªº°Ó«~¦@¦³¦h¤Ö
«¢Åo~¤j®a¦n§r

¦^´_ 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

¦^´_ 2# samwang


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

¦pªG§A¤è«Kªº¸Ü
¥i¥H¤U¤@¨Çµù¸Ñ¶Ü?  
¹ï©ó¦r¨å ÁÙ¦³°}¦Cªº¥Îªk
§Ú¤ñ¸û·Q¤£³z
·PÁ§A³á
«¢Åo~¤j®a¦n§r

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

¦^´_ 4# samwang


«D±`·PÁÂsamwang¤j¤j±Ð¾Ç
ÁÂÁ§A
«¢Åo~¤j®a¦n§r

TOP

        ÀR«ä¦Û¦b : ¹D¼w¬O´£ª@¦Û§Úªº©ú¿O¡A¤£¸Ó¬O¨þ¥¸§O¤HªºÃ@¤l¡C
ªð¦^¦Cªí ¤W¤@¥DÃD