[µo°Ý] ¬O§_¥i¥[³t·j´Mªº³t«×

adam2010

¦U¦ì°ª¤â¡A­n®Ú¾ÚSheet1ªº§å¦¸

¤U¸ü (28.52 KB)

2015-6-19 22:05

¥hSheet2§ä¹ê»ÚÀx¦ì(´N¬OSheet2ªº¼ÐÃD¦C)

¤U¸ü (40.93 KB)

2015-6-19 22:05

¥Ø«eªº¥¨¶°¦p¤U~¥i°õ¦æ¡A¦ý¬O¸ê®Æ¶q¤j®É·|§ä«Ü¤[¡A·Q½Ð±Ð¦U¦ì¬O¤£¬O¦³¤ñ¸û§Öªº¤èªk¡AÁÂÁ¡I
Sub AA()
Z = Sheet1.[A65536].End(xlUp).Row
For ZZ = 2 To Z
   For X = 1 To 48
     For Y = 1 To 1000
If Sheet1.Cells(ZZ, 1) = Sheet2.Cells(Y, X) Then
Sheet1.Cells(ZZ, 4) = Sheet2.Cells(1, X)
End If
    Next
      Next
         Next
End Sub

P001-P100¹q¸£.zip (7.8 KB)

¤U¸ü¦¸¼Æ: 15

2015-6-19 22:05

Andy2483

¦^´_ 11# shuo1125


    ÁÂÁ«e½ú¤@°_¾Ç²ß

       ' ¡õ¹M¾ú xA ¤¤ªº¼ÐÃD¤U¤è¨C¤@­Ó«DªÅ®æÀx¦s®æ¡A
    For Each A In xA.Offset(1, 0).SpecialCells(2)
        ' ¡õ¦b¦r¨å¤¤²K¥[¶µ¥Ø¡AKey¬°AÀx¦s®æ­È ,Item¬°AÀx¦s®æ©Ò¦bÄæ¦ì¼ÐÃD¦Cªº¼ÐÃD­È
        ' ¡õA¬O³q¥Î«¬ÅܼÆ,¦b¦¹³B¬Oª«¥ó(Àx¦s®æ),©Ò¥H­n¥HAªº­È¯Ç¤J¦r¨å,©Ò¥H­n¥[.Value©Î¥[ & ""
        Z(A.Value) = xA.Cells(1, A.Column).Value
    Next A

shuo1125

¦^´_ 10# Andy2483
·PÁÂAndy¤j¤À¨ÉFor Each¥t¸Ñ¡A­ì¨ÓxlCellTypeConstants¥]§t±`¼ÆªºÀx¦s®æ¤]¯à³o¼Ë¨Ï¥Î¡A
¥H¤U¦³¿ù¦b·Ð½Ð«ü¥¿¡C

        ' ¹M¾ú xA ¤¤ªº¨C¤@­ÓÀx¦s®æ¡A±Æ°£¼ÐÃD
    For Each A In xA.Offset(1, 0).SpecialCells(2)
        ' ¦b¦r¨å¤¤²K¥[¶µ¥Ø¡AÁ䬰A ­È¬°xA
        Z(A.Value) = xA.Cells(1, A.Column).Value
    Next A

Andy2483

¦^´_ 9# chen301222


    ÁÂÁ½׾Â,Åwªï«e½ú¤@°_¤W½×¾Â¾Ç²ß
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U

Option Explicit
Sub TEST_1()
Dim Brr, Z, i&, A As Range, j&, xA As Range
Set Z = CreateObject("Scripting.Dictionary")
Set xA = [Sheet2!A1].CurrentRegion
For Each A In xA.Offset(1, 0).SpecialCells(2)
   Z(A & "") = xA.Cells(1, A.Column) & ""
Next
Brr = Range([Sheet1!A2], ¤u§@ªí1.Cells(Rows.Count, "A").End(3))
For i = 1 To UBound(Brr)
   Brr(i, 1) = Z(Brr(i, 1) & "")
Next
[Sheet1!D2].Resize(UBound(Brr)) = Brr
End Sub

chen301222

Sub FIND()
Dim arr, i, j, d As Object
Set d = CreateObject("Scripting.Dictionary")
With Sheets("sheet2")
    arr = .[a1].CurrentRegion
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If arr(i, j) <> "" Then
                d(arr(i, j)) = arr(1, j)
            End If
        Next j
    Next i
End With
With Sheets("sheet1")
    arr = .[a1].CurrentRegion
    For i = 2 To UBound(arr)
        If d.exists(arr(i, 1)) Then
            arr(i, 4) = d(arr(i, 1))
        End If
    Next i
    .[a1].CurrentRegion = arr
End With
End Sub

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
²{¾Ç²{¥Î http://forum.twbts.com/redirect. ... o=lastpost#lastpost
Arr(i, 1) = xD(Arr(i, 1))
'¡ô¥O¥HArr°}¦C­È¬dxD¦r¨å,±N¦^¶Ç­È¨ú¥N­ì¨Óªº°}¦C­È,
'­Y¬d¤£¨ì·|¦^¶ÇªÅ¦r¤¸¨ú¥N­ì¨Óªº°}¦C­È
=========================================

°õ¦æ«e:

¤U¸ü (98.26 KB)

2023-5-9 16:06

°õ¦æµ²ªG:

¤U¸ü (106.54 KB)

2023-5-9 16:06

Option Explicit
Sub TEST()
Dim Brr, Y, i&, j%, xR As Range, Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("Sheet1"): Set Sh2 = Sheets("Sheet2")
Set xR = Sh2.[A1].CurrentRegion: Brr = xR
For i = 1 To UBound(Brr)
   For j = 1 To UBound(Brr, 2)
      If Brr(i, j) <> "" Then Y(Brr(i, j)) = Brr(1, j)
   Next
Next
Set xR = Range(Sh1.[A2], Sh1.Cells(Rows.Count, 1).End(3)): Brr = xR
For i = 1 To UBound(Brr)
   Brr(i, 1) = Y(Brr(i, 1))
Next
xR.Offset(0, 3) = Brr
Set Y = Nothing: Set xR = Nothing: Set Sh1 = Nothing: Set Sh2 = Nothing
Erase Brr
End Sub

adam2010

·PÁÂGBKEE¤]¥X¤â¬Û§U¡A¤£¹L²{¦b¤~¬Ý¨ì¡Aªì¨B´ú¸Õ¹LOK¡A¤U¯Z¦A¬ã¨s¬ã¨s¡AÁÂÁ¡I

GBKEE

¦^´_ 5# adam2010
¥i°Ñ¦Ò¤@¤U

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim d As Object, C As Range, i As Double, Ar()
   
4.     Set d = CreateObject("scripting.dictionary") '¦r¨åª«¥ó
   
5.     For Each C In Sheets("SHEET2").UsedRange.Columns
   
6.         i = 2
   
7.         While C.Cells(i) <> ""
   
8.             d(C.Cells(i).Value) = C.Cells(1)
   
9.             i = i + 1
   
10.         Wend
    
11.     Next
    
12.     With Sheets("SHEET1")
    
13.         Ar = .UsedRange.Columns(1).Value
    
14.         Ar(1, 1) = "¹ê»Ú¦ì¸m"
    
15.         For i = 2 To UBound(Ar)
    
16.             Ar(i, 1) = d(Ar(i, 1))
    
17.         Next
    
18.         .[D1].Resize(UBound(Ar)) = Ar
    
19.     End With
    
20. End Sub

½Æ»s¥N½X

adam2010

·PÁÂlpk187ªº¨ó§U¡A³t«×§Ö«Ü¦h
¤]ÁÂÁÂPKKO´£¨Ñªº°}¦C¤è¦¡¡A¥u¬O¦]¬°¨Ó·½¸ê®Æ¬O¤H­û¥h½T»{¹ê»ÚÀx¦ì³vµ§¿é¤J¡A©Ò¥H¥i¯àµLªk½T©w"¨C¤@µ§¸ê®Æ³£­n³sÄò"

PKKO

±N±zªºµ{¦¡½XÂà´«¬°°}¦C
³t«×´N·|ª½±µ¤j´T«×´£¤É
«Ø¥ß°}¦Cªº¤è¦¡¦³«Ü¦hºØ
¤U¦C«Ø¥ß°}¦C¤è¦¡»Ý­nª`·N:.¨C¤@µ§¸ê®Æ³£­n³sÄò

¥Ñ°}¦Cªº­È©ñ¤JEXCELªº¤è¦¡¤]¤£¦P
¤U¦C¤è¦¡¬O³Ì²³æ¤]¬O³ÌºCªº,¦ý±zªº¸ê®Æ¶q¦pªG©ñ¤J­È¥u¦³¦b¤@¤d­Ó¤§¤º
À³¸ÓÁÙ·P¨ü¤£¨ì¤@¬íªº®t²§

1. Sub test()
   
2.     Z = Sheet1.[A65536].End(xlUp).Row
   
3.     Rng = Sheet1.[a1].CurrentRegion
   
4.     rng2 = Sheet2.[a1].CurrentRegion
   
5.    
   
6.     For ZZ = 2 To Z
   
7.         For X = 1 To 48
   
8.             For Y = 1 To 1000
   
9.                 If Rng(ZZ, 1) = rng2(Y, X) Then
   
10.                     Sheet1.Cells(ZZ, 4) = Rng(1, X)
    
11.                 End If
    
12.             Next
    
13.         Next
    
14.     Next
    
15. End Sub

½Æ»s¥N½X