- ©«¤l
- 522
- ¥DÃD
- 36
- ºëµØ
- 1
- ¿n¤À
- 603
- ÂI¦W
- 0
- §@·~¨t²Î
- win xp sp3
- ³nÅ骩¥»
- Office 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-12-13
- ³Ì«áµn¿ý
- 2021-7-11
|
¸Õ¸ÕVBA:- Option Explicit
- '°ÆVBA
- '±N¦Uªíªº«~¶µ½s¸¹¥þ³¡¶×¤JÁ`ªíªºÄæB(¥Î¤£«Âпz¿ï)
- Sub ¨ú±o¥þ³¡«~¶µ½s¸¹()
- Dim sh2 As Worksheet
- Dim i, shCnt, LastRow1, LastRow2 As Integer
- Set sh2 = Sheets("Á`ªí")
- Dim Rng1, Rng2 As Range
- '²M°£¤u§@°Ï
- sh2.[A3:IU65536].ClearContents
- shCnt = ThisWorkbook.Sheets.Count
-
- '±N«~¶µ½s¸¹¥þ³¡¶×¤JÁ`ªíªºÄæIU
- For i = 1 To shCnt
- If Sheets(i).Name <> sh2.Name Then
- LastRow1 = Sheets(i).[B65536].End(xlUp).Row
- LastRow2 = sh2.[IU65536].End(xlUp).Row + 1
- Sheets(i).[B3].Resize(LastRow1 - 2, 1).Copy sh2.Cells(LastRow2, 255)
- End If
- Next
- '¨Ã±NÁ`ªíªºÄæIUªº«~¶µ½s¸¹,¥Î¤£«Âпz¿ï¨ìÁ`ªíªºÄæA
- sh2.[IU2:IU65536].AdvancedFilter Action:=xlFilterCopy, _
- CopyToRange:=sh2.[A2], Unique:=True
- '²M°£¼È¦s°Ï
- sh2.[IU3:IU65536].ClearContents
- End Sub
- '¥DVBA
- Private Sub «Ø¥ßÁ`ªí_Click()
- Dim sh2 As Worksheet
- Dim i, j, shCnt, LastRow1, Row2, LastCol2 As Integer
- Dim FindStr As String
- Dim Rng1, FindRng As Range
- Set sh2 = Sheets("Á`ªí")
- sh2.Activate
- shCnt = ThisWorkbook.Sheets.Count
- ¨ú±o¥þ³¡«~¶µ½s¸¹
- For i = 1 To shCnt
- If Sheets(i).Name <> sh2.Name Then
- LastRow1 = Sheets(i).[B65536].End(xlUp).Row
- For j = 3 To LastRow1
- Set Rng1 = Sheets(i).Cells(j, 2)
- 'sh2.[A:A]¬O±ý·j´M½d, Y·j´M¨ì FindStr «h¦s¤J FindRng, §_«h FindRng=Nothing
- FindStr = Rng1
- Set FindRng = sh2.Range("A:A").Find(FindStr, lookat:=1)
- If Not FindRng Is Nothing Then
- LastCol2 = sh2.Cells(FindRng.Row, 255).End(xlToLeft).Column + 1
- FindRng.Offset(0, LastCol2 - 1) = Sheets(i).Cells(j, 12) '¥Í²£¤é´Á
- FindRng.Offset(0, LastCol2) = Sheets(i).Cells(j, 13) '¦³®Ä¤é´Á
- End If
- Next
- End If
- Next
- sh2.[A2].Select
- End Sub
½Æ»s¥N½X
|
|