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

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

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

¥»©«³Ì«á¥Ñ 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

        ÀR«ä¦Û¦b : ¬°¦Û¤v§äÂǤfªº¤H¥Ã»·¤£·|¶i¨B¡C
ªð¦^¦Cªí ¤W¤@¥DÃD