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

[µo°Ý] ¦p¦ó¿é¤J¨â­Ó¸ê®Æ¦ÛÁ`ªí¤¤¿z¥X¸ê®Æ¡A¿é¤J¦b¥t¤@¤À­¶

[µo°Ý] ¦p¦ó¿é¤J¨â­Ó¸ê®Æ¦ÛÁ`ªí¤¤¿z¥X¸ê®Æ¡A¿é¤J¦b¥t¤@¤À­¶

½Ð±Ð¦U¦ì¡G

§Ú·Q±Nªþ¥ó¤¤ªºÁ`ªí¸ê®Æ­¶¤¤¡A¨Ì·ÓÀ]§O¤Î¼t°Ó§O§ì¥X¸ê®Æ¥t¦s¤JÀ]§O¤Î¼t°Ó¤À­¶¤¤¡A¦]¸ê®Æ¤º®eÄæ¦ì·|ÀH¨C¦¸µ§¼Æ¤£¦P¡A©Ò¥H¤£·|¬O©T©wµ§¼Æ¡A
µ{«×¤Ó®t´Á«Ý°ª¤H«üÂI¡C

À]§O¼t°Ó¦Û°Ê¿ï¾Ü.zip (46.11 KB)

¦^´_ 11# Andy2483
Andy ¾Ç¥S
±ß½ú¤Q¤À·PÁ§A­@¤ßªº±Ð¾É,²{¦b©ú¥Õ¤F·í¤¤ªº¹B¥Î©M§Þ¥©,
ÁÂÁ§A

TOP

¦^´_ 10# mdr0465


    ÁÂÁ«e½ú¤@°_¾Ç²ß
½Ð¸Õ°õ¦æ¥H¤U¥N½X:


Option Explicit
Sub Item_test()
Dim xA As Range, N&
With [A2:E4]
   N = .Count: .Select
   MsgBox "¦¹°Ï°ìÀx¦s®æªº¼Æ¶q¦³: " & N & " ­Ó"
   MsgBox "¦¹°Ï°ìÀx¦s®æ¸Ìªº²Ä1Äæ²Ä1¦CÀx¦s®æ¦ì§}¬O " & .Item(1, 1).Address(0, 0)
   MsgBox "¦¹°Ï°ìÀx¦s®æ¸Ìªº²Ä5Äæ²Ä3¦CÀx¦s®æ¦ì§}¬O " & .Item(3, 5).Address(1, 0)
   MsgBox "¦¹°Ï°ìÀx¦s®æ¸Ìªº²Ä6Äæ²Ä3¦CÀx¦s®æ¦ì§}¬O " & .Item(3, 6).Address(0, 1)
   MsgBox "¦¹°Ï°ìÀx¦s®æ¸Ìªº²Ä1­ÓÀx¦s®æ¦ì§}¬O " & .Item(1).Address(1, 1)
   MsgBox "¦¹°Ï°ìÀx¦s®æ¸Ìªº²Ä5­ÓÀx¦s®æ¦ì§}¬O " & .Item(5).Address
   MsgBox "¦¹°Ï°ìÀx¦s®æ¸Ìªº²Ä6­ÓÀx¦s®æ¦ì§}¬O " & .Item(6).Address
   MsgBox "¦¹°Ï°ìÀx¦s®æ¸Ìªº³Ì«á¤@­ÓÀx¦s®æ¦ì§}¬O " & .Item(N).Address
   MsgBox "¦¹°Ï°ìÀx¦s®æ¤W¤@¦C²Ä5ÄæÀx¦s®æ¦ì§}¬O " & .Item(0, 5).Address
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 9# Andy2483

Andy ¾Ç¥S, «á½ú¦³¤@¨Ç½s½X¤WªººÃ°Ý·Q¦V§A½Ð±Ð

Sub TEST()
Dim Brr, V, Z, i&, R&, À]$, ¼t$
Sheets("À]§O¤Î¼t°Ó").UsedRange.Offset(3).EntireRow.Delete
À] = [À]§O¤Î¼t°Ó!C1]: ¼t = [À]§O¤Î¼t°Ó!E1]: If À] = "" Or ¼t = "" Then Exit Sub
Brr = Range([Á`ªí!L1], [Á`ªí!A65536].End(xlUp))
For i = 3 To UBound(Brr)
   If Brr(i, 1) <> À] Or Brr(i, 12) <> ¼t Then GoTo i01 Else R = R + 1
   Brr(R, 1) = Brr(i, 2): Brr(R, 2) = Brr(i, 3): Brr(R, 3) = Brr(i, 4)
   Brr(R, 4) = Val(Brr(i, 11)): Brr(R, 5) = Val(Brr(i, 10))
   V = V + Brr(R, 4) * Brr(R, 5)
i01: Next
If R = 0 Then Exit Sub
With [À]§O¤Î¼t°Ó!A4].Resize(R, 5)
   .Value = Brr: .Item(0, 5) = "=Á`ªí!J2"
   For i = 7 To 10: .Borders(i).Weight = 4: Next
  .Item(.Count + 4) = "¦X­p": .Item(.Count + 5) = V
  .Item(.Count + 5).NumberFormatLocal = "G/³q¥Î®æ¦¡""¤¸"""
End With
End Sub

½Ð°Ý¥H¤W¬õ¦âªº¼Ð°O ".item(xxxxx) ¬O¤°»ò·N«ä©O? ¬O«ç¼Ë¥Îªk©O? §Ú¦bºô¤W§ä¹L,¦ý³£ÁÙ¬O¤@ÀYÃú¤ô,©Ò¥H·Q½Ð¾Ç¥S«ü±Ð,ÁÂÁÂ

TOP

ÁÂÁ½׾Â(5001),ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
µ²ªGªí²M°£Â¸ê®Æ:


¸ê®Æªí:


°õ¦æµ²ªG:


Option Explicit
Sub TEST()
Dim Brr, V, Z, i&, R&, À]$, ¼t$
Sheets("À]§O¤Î¼t°Ó").UsedRange.Offset(3).EntireRow.Delete
À] = [À]§O¤Î¼t°Ó!C1]: ¼t = [À]§O¤Î¼t°Ó!E1]: If À] = "" Or ¼t = "" Then Exit Sub
Brr = Range([Á`ªí!L1], [Á`ªí!A65536].End(xlUp))
For i = 3 To UBound(Brr)
   If Brr(i, 1) <> À] Or Brr(i, 12) <> ¼t Then GoTo i01 Else R = R + 1
   Brr(R, 1) = Brr(i, 2): Brr(R, 2) = Brr(i, 3): Brr(R, 3) = Brr(i, 4)
   Brr(R, 4) = Val(Brr(i, 11)): Brr(R, 5) = Val(Brr(i, 10))
   V = V + Brr(R, 4) * Brr(R, 5)
i01: Next
If R = 0 Then Exit Sub
With [À]§O¤Î¼t°Ó!A4].Resize(R, 5)
   .Value = Brr: .Item(0, 5) = "=Á`ªí!J2"
   For i = 7 To 10: .Borders(i).Weight = 4: Next
   .Item(.Count + 4) = "¦X­p": .Item(.Count + 5) = V
   .Item(.Count + 5).NumberFormatLocal = "G/³q¥Î®æ¦¡""¤¸"""
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

·PÁÂ Kubi
¤w¸g¥i¥H¥¿¦¡¨Ï¥Î¤F¡A«D±`·PÁÂ

TOP

¥»©«³Ì«á¥Ñ Kubi ©ó 2019-3-25 20:34 ½s¿è
  1. Sub test()
  2.     Dim d As Object
  3.     Dim arr
  4.     Dim brr()
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     With Sheets("Á`ªí")
  7.         er = .[A65536].End(3).Row
  8.         arr = .Range("A3:L" & er)
  9.         For c = 5 To 9
  10.            d(.Cells(2, c).Value) = c
  11.         Next c
  12.     End With
  13.     room = Sheets("À]§O¤Î¼t°Ó").[C1].Value
  14.     store = Sheets("À]§O¤Î¼t°Ó").[E1].Value
  15.     n = 0
  16.     For i = 1 To UBound(arr)
  17.         If arr(i, 1) = room And arr(i, 12) = store Then
  18.             n = n + 1
  19.             ReDim Preserve brr(1 To 4, 1 To n)
  20.             For j = 1 To 3
  21.                 brr(j, n) = arr(i, j + 1)
  22.             Next j
  23.             brr(4, n) = arr(i, d(store))
  24.         End If
  25.     Next i
  26.     If n <> 0 Then
  27.         Sheets("À]§O¤Î¼t°Ó").Rows("4:65536").Delete
  28.         Sheets("À]§O¤Î¼t°Ó").[A4].Resize(n, 4) = Application.Transpose(brr)
  29.     Else
  30.         MsgBox "§ä¤£¨ì"
  31.     End If
  32.     Set d = Nothing
  33.     Erase brr
  34.     arr = ""
  35. End Sub
½Æ»s¥N½X
¦^´_ 6# tsuan

TOP

¦^´_ 4# Kubi


½Ð°ÝKudi¤j¤j:

§Ú¦bÁ`ªí¸ê®Æ¤W¤è´¡¤J¤@¦C¡A§Y¥X²{°}¦C¯Á¤Þ®Ñ½u¿ù»~°T®§¡AÀµ½Ð±z¦A«ü¾É¤@¤U¡AÁÂÁ¡C

À]§O¼t°Ó¦Û°Ê¿ï¾Ü.zip (53.83 KB)

TOP

·PÁÂ Kubi
¥¿¬O¦p§Ú©Ò»Ý­nªº¡A«D±`·P¿E

TOP

¦^´_ 1# tsuan
½Ð°Ñ¦Ò
  1. Sub test()
  2.     Dim d As Object
  3.     Dim arr
  4.     Dim brr()
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     With Sheets("Á`ªí")
  7.         er = .[A65536].End(3).Row
  8.         arr = .Range("A2:L" & er)
  9.         For c = 5 To 9
  10.             d(.Cells(1, c).Value) = c
  11.         Next c
  12.     End With
  13.     room = Sheets("À]§O¤Î¼t°Ó").[C1].Value
  14.     store = Sheets("À]§O¤Î¼t°Ó").[E1].Value
  15.     n = 0
  16.     For i = 1 To UBound(arr)
  17.         If arr(i, 1) = room And arr(i, 12) = store Then
  18.             n = n + 1
  19.             ReDim Preserve brr(1 To 4, 1 To n)
  20.             For j = 1 To 3
  21.                 brr(j, n) = arr(i, j + 1)
  22.             Next j
  23.             brr(4, n) = arr(i, d(store))
  24.         End If
  25.     Next i
  26.     If n <> 0 Then
  27.         Sheets("À]§O¤Î¼t°Ó").Rows("4:65536").Delete
  28.         Sheets("À]§O¤Î¼t°Ó").[A4].Resize(n, 4) = Application.Transpose(brr)
  29.     Else
  30.         MsgBox "§ä¤£¨ì"
  31.     End If
  32.     Set d = Nothing
  33.     Erase brr
  34.     arr = ""
  35. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : §g¤l¬°¥Ø¼Ð¡A¤p¤H¬°¥Øªº¡C
ªð¦^¦Cªí ¤W¤@¥DÃD