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

[µo°Ý] ¬d¸ß«á¶Ç¦^¦hµ§¸ê®Æ¥H¾ðª¬¥Ø¿ý¤è¦¡¸m©ñ

[µo°Ý] ¬d¸ß«á¶Ç¦^¦hµ§¸ê®Æ¥H¾ðª¬¥Ø¿ý¤è¦¡¸m©ñ

¤u§@¦³ÂI½ÆÂø¡A¦bªþÀɤ¤¦³¸Ô²Ó»¡©ú

test.rar (29.82 KB)
Jess

¦^´_ 1# jesscc
¬d¸ß
  1. Sub query()
  2. Dim i%, Ar(), A As Range
  3. If Sheet33.OptionButton7.Object.Value = True Then
  4. Set d = CreateObject("Scripting.Dictionary")
  5. Set d1 = CreateObject("Scripting.Dictionary")
  6.     With Sheets("DATA")
  7.         For Each A In Range(.[B5], .[B65536].End(xlUp))
  8.             d(A.Value) = A.Offset(, 3).Value
  9.             d1(A.Value) = Array(A.Value, "", A.Offset(, 3).Value, A.Offset(, 4).Value, A.Offset(, 10).Value)
  10.         Next
  11.     End With
  12.     With Sheets("B")
  13.         For Each A In Range(.[D12], .[D65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
  14.            For Each ky In d.keys
  15.               If ky <> A And d(ky) = d(A.Value) Then
  16.               ReDim Preserve Ar(s)
  17.               Ar(s) = d1(ky)
  18.               s = s + 1
  19.               End If
  20.            Next
  21.            If s > 0 Then
  22.            A.Offset(1, 0).Resize(s, 1).EntireRow.Insert
  23.            A.Offset(1, 1).Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
  24.            s = 0: Erase Ar
  25.            End If
  26.         Next
  27.     End With
  28. End If
  29. Set d = Nothing
  30. Set d1 = Nothing
  31. End Sub
½Æ»s¥N½X
´À¥N®Æ
  1. Private Sub OptionButton7_Click()
  2. Dim i%
  3. [E11] = "´À¥N®Æ"
  4. Columns("G:J").EntireColumn.Hidden = False
  5. Var = MsgBox("³o¼Ë°µ·|§R°£§A¤§«e©Ò°µªº¬d¸ßµ²ªG¡C" & vbCrLf & vbCrLf & "¦ý¤£·|§R°£­ì¨Óªº PN¡C" & vbCrLf & vbCrLf & "½Ð½T©w§A­n¶i¦æªº¬d¸ß¶µ¥Ø !" & vbCrLf & vbCrLf & "¥i¥H«ö""¨ú®ø""Â÷¶}!", 33, "¾Þ§@¨BÆJ´£¥Ü!")
  6.      If Var = 2 Then
  7.      OptionButton6 = True
  8.      Columns("G:J").EntireColumn.Hidden = True
  9.        Exit Sub
  10.      Else
  11.      Range([E12], Cells(Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeConstants).EntireRow.Delete
  12.      End If
  13.   End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ jesscc ©ó 2011-10-22 14:08 ½s¿è

¦^´_ 2# Hsieh


    ·PÁÂH¤jÀ°¦£!
µ{¦¡¹B§@¤j­POK¡A§R°£¦Cªº®É­Ô¦³ÂI¤p°ÝÃD¡A§Ú§â­ì©lÀÉSub query()ªº³¡¤À°µ¤F¤@¨Ç­×§ï¡A¥[¤J¤FOpenOrderªº¬d¸ß¡A¥»¨ÓÁÙ·Q»¡À³¸Ó¤£Ãø¡A¦]¬°³o­Ó³¡¤À¤£¥Î¦Ò¶q±Æ°£­ì©lPNªº°ÝÃD¡A¥u¦³¸ê®Æ©ñ¸mªº°ÝÃD¡C§Ú¥ÎCallªº¤è¦¡¡A¦b¤@­ÓSub¸Ì¥hCall¤£¦Pªº¬d¸ß¡Aµ²ªGOpenOrderªº³¡¤ÀµLªk¥¿±`¬d¸ß(°»¿ù:¦¹³B»Ý­nª«¥ó)¡A¦Ó¥B¦pªG¤@ª½«ö"¬d¸ß"«ö¶s¡A·|³s¼ÐÃD¦C³£³Q§R°£¡A¤£ª¾­þ¸Ì¦³°ÝÃD¡A§ÖºÆ¤F><

test1.rar (57.12 KB)
Jess

TOP

¥»©«³Ì«á¥Ñ jesscc ©ó 2011-10-22 22:45 ½s¿è

¤w­×¥¿¿ù§R¼ÐÃD¦Cªº°ÝÃD¡A¨Ã¥B¤]¥i¥H¬d¸ß¤F¡A¥u¬O¬d¸ßµ²ªG¤£²Å©Ò»Ý¡A¥u¯à¶Ç¦^³Ì«á¤@µ§
  1. Sub query1()
  2. Dim i%, Ar(), A As Range
  3. If [E13] <> "" Then
  4.      Columns("G:I").EntireColumn.Hidden = True
  5.      Range([E13], Cells(Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeConstants).EntireRow.Delete
  6. AA:
  7. Set d = CreateObject("Scripting.Dictionary")
  8. Set d1 = CreateObject("Scripting.Dictionary")

  9.     With Sheets("OpenOrder")
  10.         For Each A In Range(.[E7], .[E65536].End(xlUp))
  11.             d(A.Value) = A.Offset(, 2).Value
  12.             d1(A.Value) = Array(A.Value, A.Offset(, 1).Value, "", "", "", A.Offset(, 5).Value, "", "", A.Offset(, 8).Value, A.Offset(, 9).Value, A.Offset(, 10).Value, A.Offset(, 11).Value, A.Offset(, 12).Value)
  13.         Next
  14.     End With
  15.     With Sheets("B")
  16.         For Each A In Range(.[D12], .[D65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
  17.            For Each ky In d.keys
  18.               If ky = A Then
  19.               ReDim Preserve Ar(s)
  20.               Ar(s) = d1(ky)
  21.               s = s + 1
  22.               End If
  23.            Next
  24.            
  25.            If s > 0 Then
  26.            A.Offset(1, 0).Resize(s, 1).EntireRow.Insert
  27.            A.Offset(1, 1).Resize(s, 13) = Application.Transpose(Application.Transpose(Ar))
  28.            s = 0: Erase Ar
  29.            End If
  30.         Next
  31.     End With


  32. Set d = Nothing
  33. Set d1 = Nothing
  34. Else
  35. GoTo AA
  36. End If
  37. End Sub
½Æ»s¥N½X
Jess

TOP

        ÀR«ä¦Û¦b : ¥¬¬I¦p¼½ºØ¡A¥HÅw³ß¤ß´þ¼íºØ¤l¡A¤~·|µoªÞ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD