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

[µo°Ý] ¦p¦ó§ä¥X¯S©w¼Æ­È©Ò¹ïÀ³ªºÀx¦s®æ¤º®e

¦^´_ 10# luke

"¸ô¤H¥Ò"¦h¼L
¥ý´N¨Æ½×¨Æ
1.  2#  Hsieh¶Wª© ¤w¥ÎVBA¦^µª±z 1#¤§´£°Ý
      ­Y¥\¯à¦³¿ù»~©Î¤£²Å±zªº»Ý¨D
      ´NÀ³§Y®É¤ÏÀ³,¦Ó±z¦b4#¬OµªÂÐ"´ú¸ÕOK"
2.  ½×¾Â¤W¶Wª©,ª©¥D¦bEXCEL¤@¯ë°Ï,µ{¦¡°Ï¤W¤§¥\¤OµL±e¸mºÃ
     "¸ô¤H¥Ò"¤£¾á¤ß¶Wª©,ª©¥D¦^µª¤£¥X°ÝÃD,¥u­n¶Wª©,ª©¥D¦³®É¶¡,µo°ÝªÌªº´£°Ý¯àÅý¶Wª©,ª©¥D¤F¸Ñ¥\¯à»Ý¨D,³£¬Oªá¤F®É¶¡,ºÉ¤ßºÉ¤Oªº¦^µª
     "¸ô¤H¥Ò"¦b·Nªº¬Oµo°ÝªÌªº´£°Ý ÃD¥Ø¤£²M·¡ ¤Ó竉²Î ¤£ªþÀÉ®× ¤Ï¤ÏÂÐÂÐ
3. µo©««á,¨C¤@¼h¼Ó¤§´£°Ý,µªÃD³£À³¦³¤@©wªº¶¶§Ç
    ¤£µM·|Åý¬Ý©«ªº¤H»~¸Ñ,¤]·|¨S¦³®Ä²v

TOP

¦^´_ 11# register313


    ÁÂÁ¦^ÂÐ

¥ý«eªB¤Í¤¶²Ð±q§Oªº½×¾Â´Nª¾¹DH¶Wª©¤j¥\¤O, ¤p§Ì¬O¨S¦³¥ô¦óÃhºÃ

³o¦¸§ïÅܬO¦]¬°­ì¥ýsheet1ªíBÄæ¬O±Äª«¥ó¸¹½X§@³B²z, ¦]¦¹´ú¸ÕOK

²{¦b¦]¸ê®Æ§ï¬°ª«¥ó¦a§}±Ä¤Q¤»¶i¦ì¤~·|¦³¤ñ¸û¤W¿ù»~

¥H¤W»¡©ú

·Ð½Ð¤j¤j, ¥ý¶i«ü¾É, ÁÂÁÂ!

TOP

¦^´_ 10# luke

¥Î¤FÂù¼h°j°é,°õ¦æ®Ä¯à¤£¨Î(­Y¸ê®Æ¦³¤W¸Uµ§,§ÚªºÂù®Ö¹q¸£¶]¤F¬ù20¬í)
°Ñ¦Ò¥Î
  1. Sub zz()
  2. Application.ScreenUpdating = False
  3. With sheet1
  4. .Columns("A:B").Copy .Columns("F:G")
  5. .Columns("H:I") = ""
  6. Max = sheet2.[F1].End(xlToRight).Value
  7. For Each S In .Range(.[A1], .[A1].End(xlDown))
  8.   For Each T In sheet2.Range(sheet2.[D2], sheet2.[D2].End(xlDown))
  9.     If S & S.Offset(0, 1) = T & T.Offset(0, 1) Then
  10.        If Val(S.Offset(0, 2)) <= Max And Val(S.Offset(0, 3)) <= Max Then
  11.           S.Offset(0, 7) = sheet2.Cells(T.Row, S.Offset(0, 2) + 6)
  12.           S.Offset(0, 8) = sheet2.Cells(T.Row, S.Offset(0, 3) + 6)
  13.        End If
  14.        Exit For
  15.     End If
  16.   Next
  17.   If S.Offset(0, 7) = "" Then S.Offset(0, 2).Resize(1, 2).Copy S.Offset(0, 7)
  18. Next
  19. End With
  20. Application.ScreenUpdating = True
  21. MsgBox "°õ¦æ§¹²¦"
  22. End Sub
½Æ»s¥N½X

TOP

¦^´_ 12# luke
  1. Option Explicit
  2. Sub Ex°}¦C()
  3.     Dim Ar1(), Ar2(), A As Range, S As Variant, xR(1 To 2)
  4.     S = 1
  5.     With sheet2
  6.         For Each A In .Range(.[D2], .[D2].End(xlDown))
  7.             ReDim Preserve Ar1(1 To S)
  8.             ReDim Preserve Ar2(1 To S)
  9.             Ar1(S) = A & A.Cells(1, 2)
  10.             Ar2(S) = .Range(A.Cells(1, 3), A.Cells(1, 2).End(xlToRight)).Value
  11.             Ar2(S) = Application.Transpose(Application.Transpose(Ar2(S)))
  12.             S = S + 1
  13.         Next
  14.     End With
  15.     With sheet1
  16.         For Each A In .Range(.[A1], .[A1].End(xlDown))
  17.             S = Application.Match(A & A(1, 2), Ar1, 0)
  18.             If Not IsError(S) Then
  19.                 xR(1) = A(1, 3)
  20.                 xR(2) = A(1, 4)
  21.                 If IsNumeric(A(1, 3)) Then If A(1, 3).Value + 1 <= UBound(Ar2(S)) Then xR(1) = Ar2(S)(A(1, 3) + 1)
  22.                 If IsNumeric(A(1, 4)) Then If A(1, 4).Value + 1 <= UBound(Ar2(S)) Then xR(2) = Ar2(S)(A(1, 4) + 1)
  23.                 A.Offset(, 5).Resize(, 4) = Array(A, A(1, 2), xR(1), xR(2))
  24.             Else
  25.                 A.Offset(, 5).Resize(, 4) = A.Resize(, 4).Value
  26.             End If
  27.         Next
  28.     End With
  29. End Sub

  30. Sub Ex¦r¨åª«¥ó()
  31.     Dim d As Object, Ar(), A As Range, C As Range, B As Range, x As String
  32.     Set d = CreateObject("Scripting.Dictionary")
  33.     With sheet2
  34.         For Each A In .Range(.[D2], .[D2].End(xlDown))
  35.             x = A & A.Cells(1, 2)
  36.             For Each C In .Range(A.Cells(1, 3), A.Cells(1, 2).End(xlToRight))
  37.                 If d.Exists(x) Then
  38.                     Ar = d(x)
  39.                     ReDim Preserve Ar(UBound(Ar) + 1)
  40.                     Ar(UBound(Ar)) = C.Value
  41.                     d(x) = Ar
  42.                 Else
  43.                     d(x) = Array(C.Value)
  44.                 End If
  45.             Next
  46.         Next
  47.     End With
  48.     With sheet1
  49.         For Each A In .Range(.[A1], .[A1].End(xlDown))
  50.             If d.Exists(A & A(1, 2)) Then
  51.                 ReDim Ar(2)
  52.                 Ar(0) = d(A & A(1, 2))
  53.                 If A(1, 3) <= UBound(Ar(0)) Then Ar(1) = Ar(0)(A(1, 3)) Else Ar(1) = A(1, 3)
  54.                 If A(1, 4) <= UBound(Ar(0)) Then Ar(2) = Ar(0)(A(1, 4)) Else Ar(2) = A(1, 4)
  55.                 A.Offset(, 5).Resize(, 4) = Array(A, A(1, 2), Ar(1), Ar(2))
  56.             Else
  57.                 A.Offset(, 5).Resize(, 4) = A.Resize(, 4).Value
  58.             End If
  59.         Next
  60.     End With
  61. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : °µ¸Ó°µªº¨Æ¬O´¼¼z¡A°µ¤£¸Ó°µªº¨Æ¬O·Mè¡C
ªð¦^¦Cªí ¤W¤@¥DÃD