[µo°Ý] ¸ê®Æ¤ñ¸û«áºI¥X©Ò»Ý¸ê®Æ

jcchiang

¦b(¸ê®ÆSheet)¤º¤ñ¹ï¦³µL(§ì¨úItem Sheet)¤º¬Û¦Pªº¦WºÙ«á,
±N¬Û¦P¸ê®Æ²¾¦Ü(µ²ªGSheet),½Ð°Ý­n¦p¦ó¨Ï¥ÎVB°õ¦æ

¸ê®Æ¤ñ¸û.zip (1.78 KB)

¤U¸ü¦¸¼Æ: 23

2013-2-4 10:48

Hsieh

¦^´_ 1# jcchiang

1.     Sub ex()
   
2. Dim Rng As Range
   
3. With Sheet2
   
4.   r = 2
   
5.   Do Until .Cells(r, 1) = ""
   
6.   a = .Cells(r, 1)
   
7.   With Sheet1
   
8.      Set c = .Columns("A").Find(a, lookat:=xlWhole)
   
9.      If Not c Is Nothing Then
   
10.      Set c = c.MergeArea.Resize(, 6)
    
11.         If Rng Is Nothing Then
    
12.            Set Rng = c
    
13.         Else
    
14.            Set Rng = Union(Rng, c)
    
15.         End If
    
16.      End If
    
17.   End With
    
18.   r = r + 1
    
19.   Loop
    
20. End With
    
21. With Sheet3
    
22.   .UsedRange.Offset(1).Clear
    
23.   Rng.Copy .[A2]
    
24. End With
    
25. End Sub

½Æ»s¥N½X

jcchiang

¦^´_ 2# Hsieh


    °ÝÃD¤w¸Ñ¨M,·PÁª©¥Dªº«ü¾É

jcchiang

¦^´_ 2# Hsieh


    ÁÙ¦³¤@­Ó°ÝÃD¦A«áÄò´ú¸Õ®Éµo²{
       ·í(¸ê®ÆSheet)¤º,¦P®É¦³¤ñ¹ïªºItem¬O¬Û¦Pªº(¦P®É¦³¨â­Óa),¦ý¥u·|§ì¨ì²Ä¤@µ§
       ¹Á¸Õ­×¥¿¤´µLªk¦¨¥\§ì¥X,½Ð°Ý­n¦p¦ó­×§ï,ÁÂÁÂ

Hsieh

¦^´_ 4# jcchiang

1. Sub ex()
   
2. 
   
3. Dim Rng As Range, a, b As Range, c As Range
   
4. 
   
5. With Sheet2
   
6.   r = 2
   
7.   Do Until .Cells(r, 1) = ""
   
8.   a = .Cells(r, 1)
   
9.   With Sheet1
   
10.   Set c = Nothing
    
11.     For Each b In .Range(.[A2], .[A65536].End(xlUp))
    
12.         If b = a Then
    
13.            If c Is Nothing Then
    
14.            Set c = b.MergeArea.Resize(, 6)
    
15.            Else
    
16.            Set c = Union(c, b.MergeArea.Resize(, 6))
    
17.            End If
    
18.         End If
    
19.     Next
    
20.      If Not c Is Nothing Then
    
21.         If Rng Is Nothing Then
    
22.            Set Rng = c
    
23.         Else
    
24.            Set Rng = Union(Rng, c)
    
25.         End If
    
26.      End If
    
27.   End With
    
28.   r = r + 1
    
29.   Loop
    
30. End With
    
31. With Sheet3
    
32.   .UsedRange.Offset(1).Clear
    
33.   Rng.Copy .[A2]
    
34. End With
    
35. End Sub

½Æ»s¥N½X

jcchiang

¦^´_ 5# Hsieh

    ÅçÃÒ«á¤w¸Ñ¨M¬Û¦PItem¥u¯à§ì¨ì¤@µ§ªº°ÝÃD
    °Ñ¦Òª©¥Dªºµ{¦¡,±NFor..Next§ï¥ÎDo while..loop¤]¯à±o¨ì¤@¼Ëªº®ÄªG
       ·PÁª©¥Dªº«ü¾É
Sub ex()

Dim Rng As Range, a, b As Range, c As Range

With Sheet2
  r = 2
  Do Until .Cells(r, 1) = ""
  a = .Cells(r, 1)
  Set b = Sheet1.Range("A2")
  With Sheet1
  Set c = Nothing
    Do While b <> ""
        If b = a Then
           If c Is Nothing Then
           Set c = b.MergeArea.Resize(, 6)
           Else
           Set c = Union(c, b.MergeArea.Resize(, 6))
           End If
        End If
        Set b = b.Offset(1)
    Loop
     If Not c Is Nothing Then
        If Rng Is Nothing Then
           Set Rng = c
        Else
           Set Rng = Union(Rng, c)
        End If
     End If
  End With
  r = r + 1
  Loop
End With
With Sheet3
  .UsedRange.Offset(1).Clear
  Rng.Copy .[A2]
End With
End Sub

ADS0126

jcchiang  ¤j¤j

¦]¬°Åv­­¤£°÷µLªk¤U¸ü­ì©lÀÉ
¥u¯à¦Û¤v¸Õ¸Õ¬Ý
¬Ý¨ì³o­Ó¥DÃD«Ü²Å¦X
¥Ø«e¤u§@¤Wªº»Ý¨D
¥u¬O¦³­Ó¤p°ÝÃD???

Do Until .Cells(r, 1) = ""  <------µ{¦¡¶]¨ì¦¹¬q·|¥X²{"»Ý­nª«¥ó"

³Â·Ð¸Ñ´b

jcchiang

¦^´_ 7# ADS0126


Do Until .Cells(r, 1) = ""
³o­Ó¦ì¸m¬O©ñ­n³Q¤ñ¸ûªº¶µ¥Ø
EX:¦pªG§A­n¦b¸ê®Æ¤º·j¯Á"Test"¬ÛÃöªº¸ê®Æ
     ¨ºCells(r,1)ªº¦ì¸m´N©ñ¤J"Test"
     ¦]¬°§Ú­n¤ñ¸û«Ü¦h¸ê®Æ©Ò¥H "r" ¬°ÅܼÆ

GBKEE

¦^´_ 7# ADS0126

With Sheet2  <-§A¯Ê¤Öªºª«¥ó
  r = 2
  Do Until .Cells(r, 1) = ""   ³o.ÂI ¬Oª«¥óªºÄÝ©Ê,¤èªk¡A¤lª«¥ó¡C
  a = .Cells(r, 1)

ADS0126

jcchiang ¤j¤j

­ì¨Ó¬O³o¼Ë...µ§°O¤¤....