[µo°Ý] ¦p¦ó¤ñ¹ïData¬Û²§ªÌ ¡A§¡copy ·J¾ã¨ìsheets(1)¤¤

yangjie

½Ð±Ð¤j¤j:
sheets(1),sheets(2)¤§¦UÄæ¦ì¦W§¡¬Û¦P,
1.sheets(2)(¬ù100µ§)¤¤¦U¦C»Psheets(1)(¬ù1000µ§)¬Û²§ªÌ ¡A§¡copy ·J¾ã¨ìsheets(1)¤¤
2.§P§O¬Û²§·Ç«h:(²Ä¤@Äæ¦Ü²Ä¤Q¤GÄæ­n§¹¥þ¤@¼Ë)¤§¥~³£¥s¬Û²§
­Y¬O¤@Äæ¤@Äæ¤ñ¹ï    ·|¸¨¸¨ªø
À³¦p¦ó¼g¤~¤£·|¸¨¸¨ªø?  ¨D±Ï
ÁÂÁÂ

yangjie

¦^´_ 7# GBKEE
ÁÂÁ¦Ѯv¥Î¤ß¸Ñ»¡  ¤F¸Ñ«Ü¦h

GBKEE

¦^´_ 6# yangjie
UBound(AR)  °}¦C²Ä1ºûªº¤¸¯À¤W­­¯Á¤Þ­È,
UBound(AR, 2)  °}¦C²Ä2ºûªº¤¸¯À¤W­­¯Á¤Þ­È

1. Option Explicit
   
2. Sub EX()
   
3.     Dim d As Object, R As Range, S As String, AR(), i As Integer, ii As Integer
   
4.     Set d = CreateObject("scripting.dictionary")  '³]¥ß¦r¨åª«¥ó
   
5.     If Application.CountA(Sheets("Sheet3").Cells) = 0 Then
   
6.      '3.Sheets("Sheet3").[a1].Resize(i + 1, UBound(AR, 2)) = AR   ¦p¦ó­×§ï¬°³Ì«á¤@¦C
   
7.         ReDim Preserve AR(i)
   
8.         AR(i) = Sheets("100¦hµ§").UsedRange.Cells(1).Resize(, 12).Value
   
9.         i = i + 1
   
10.     End If
    
11.     '1.¦]¬° Äæ¦ì¦³21Äæ¦ý§PŪ¬Û²§·Ç«h1~12Äæ copy¬O21Äæ,dictionary À³¦p¦ó¼g
    
12.     For Each R In Sheets("100¦hµ§").UsedRange.Columns(1).Resize(, 12).Rows
    
13.         S = Join(Application.Transpose(Application.Transpose(R.Value)), ",")
    
14.         '¬O§_¦³§ó¦n¤§¤è¦¡? ­Y¬O§PŪ¬Û²§·Ç«h¬°²Ä¤@²Ä¥|²Ä¤E²Ä¤QÄæ
    
15.         'S = R.Cells(1, 1) & R.Cells(1, 4) & R.Cells(1, 9) & R.Cells(1, 10)
    
16.         'S = R(1, 1) & R(1, 4) & R(1, 9) & R(1, 10)
    
17.         d(S) = ""
    
18.     Next
    
19.     For Each R In Sheets("1000¦hµ§").UsedRange.Columns(1).Resize(, 12).Rows
    
20.         S = Join(Application.Transpose(Application.Transpose(R.Value)), ",")
    
21.         'S = R.Cells(1, 1) & R.Cells(1, 4) & R.Cells(1, 9) & R.Cells(1, 10)
    
22.         
    
23.         If d.exists(S) = False Then  '¦r¨åª«¥óªºKey¤£¦s¦b
    
24.         'If d(1).exists(S) = False Then  '¦r¨åª«¥óªºKey¤£¦s¦b
    
25.         '2 ¨ä¤¤d(1)¬O¬Æ»ò?  §Úªºµ§»~,­ì¥»d­n³]¬°°}¦C,
    
26.             ReDim Preserve AR(i)
    
27.             AR(i) = R.Value
    
28.             i = i + 1
    
29.         End If
    
30.     Next
    
31.     AR = Application.Transpose(Application.Transpose(AR))
    
32.     'Sheets("Sheet3").[a1].Resize(i + 1, UBound(AR, 2)) = AR
    
33.     '3.Sheets("Sheet3").[a1].Resize(i + 1, UBound(AR, 2)) = AR   ¦p¦ó­×§ï¬°³Ì«á¤@¦C
    
34.     With Sheets("Sheet3")
    
35.        .Cells(.Rows.Count, "a").End(xlUp).Offset(Abs(Application.CountA(.Range("A:A")) > 1)).Resize(i, UBound(AR, 2)) = AR
    
36.     End With
    
37. End Sub

½Æ»s¥N½X

¬°¦ó­n¨â¦¸Âà¸m
¦p¹Ï

¤U¸ü (106.94 KB)

2015-4-7 17:13

¤U¸ü (131.37 KB)

2015-4-7 17:13

yangjie

¦^´_ 2# GBKEE
½Ð±ÐGBKEEª©¤j
§Ú¤@±z¤è¦¡§@§ó§ï
wb.Activate
        Set d = CreateObject("scripting.dictionary")
        ReDim Preserve AR(k)
        AR(k) = wb.Sheets("¾Ç¥Í¸ê®Æ").UsedRange.Rows(1).Value
        For Each R In Sheets("¾Ç¥Í¸ê®Æ").UsedRange.Rows
            S = Join(Application.Transpose(Application.Transpose(Range(Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 1), Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 20)).Value)), ",")
            d(S) = ""
        Next
        wb1.Activate
        For Each R In Sheets("¾Ç¥Í¸ê®Æ").UsedRange.Rows
            S = Join(Application.Transpose(Application.Transpose(Range(Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 1), Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 20)).Value)), ",")
            If d.exists(S) = False Then  '¦r¨åª«¥óªºKey¤£¦s¦b
                k = k + 1
                ReDim Preserve AR(k - 1)
                AR(k - 1) = R.Value
            End If
        Next
        row1 = wb.Sheets("¾Ç¥Í¸ê®Æ").Range("A65536").End(xlUp).Row + 1
        AR = Application.Transpose(Application.Transpose(AR))
        wb.Sheets("¾Ç¥Í¸ê®Æ").Cells(row1, 1).Resize(k, UBound(AR, 2)) = AR
«Ü¶¶   ÁÂÁÂ
·Q¾Ç¦hÂI  ½Ð±Ð
AR = Application.Transpose(Application.Transpose(AR))    ¬°¦ó­nTranspose¨â¦¸  ?
UBound(AR, 2)  ¨ä¤¤2¥Nªídimension     ¬°¦ó­n2  ?

yangjie

¦^´_  GBKEE
¦ý§PŪ¬Û²§·Ç«h1~12Äæ copy¬O1~21Äæ
yangjie µoªí©ó 2015-4-4 01:04

¦Û¦Û¤v­×¥¿¦p¤U
Sub openfile1()
    Dim FileName1 As String
    Dim FileName() As String
    Dim xlfileName As String
    Dim nSelected As Integer
    Dim d As Object, R As Range, S As String, AR(), i As Integer
    Set wb = ActiveWorkbook
    wb.Activate
    path1 = ActiveWorkbook.Path
    ChDir path1
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = path1
        .AllowMultiSelect = True
        .Filters.Add "Excel", "*.xls; *.xlsx", 1
        .Show
        nSelected = .SelectedItems.Count
        ReDim FileName(nSelected)
        For i = 1 To .SelectedItems.Count
            FileName(i - 1) = .SelectedItems(i)
        Next
'¥Î©ó§PŪnothing
        For i = 1 To .SelectedItems.Count
            FileName1 = .SelectedItems(i)
        Next
    End With
    If FileName1 = "" Then
        MsgBox "No file was selected."
        Exit Sub
    End If

    For i = 1 To nSelected
        xlfileName = Dir(FileName(i - 1))
        If xlfileName = wb.Name Then GoTo 50
        If filetoFind(FileName(i - 1)) Then
            Application.EnableEvents = False
            If IsOpen(xlfileName) Then
                Workbooks(xlfileName).Activate
                Set wb1 = Workbooks(xlfileName)
            Else
                Set wb1 = Workbooks.Open(FileName(i - 1))
            End If
            wb.Activate
        Else
            MsgBox "§ä¤£µÛ" & FileName(i - 1)
            Application.EnableEvents = True
            Application.ScreenUpdating = True
            'Exit Sub
            GoTo 50
        End If
        Application.EnableEvents = True
        On Error Resume Next
        wb.Activate
        Set d = CreateObject("scripting.dictionary")
        For Each R In Sheets("¾Ç¥Í¸ê®Æ").UsedRange.Rows
            'S = Join(Application.Transpose(Application.Transpose(R.Value)), ",")
            S = Join(Application.Transpose(Application.Transpose(Range(Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 1), Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 20)).Value)), ",")  
¬O§_¦³§ó¦n¤§¤è¦¡? ­Y¬O§PŪ¬Û²§·Ç«h¬°²Ä¤@²Ä¥|²Ä¤E²Ä¤QÄæ     ¨º´NµLÂá¤F            
        d(S) = ""
        Next
        wb1.Activate
        For Each R In Sheets("¾Ç¥Í¸ê®Æ").UsedRange.Rows
            'S = Join(Application.Transpose(Application.Transpose(R.Value)), ",")
            S = Join(Application.Transpose(Application.Transpose(Range(Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 1), Sheets("¾Ç¥Í¸ê®Æ").Cells(R.Row, 20)).Value)), ",")
            If d.exists(S) = False Then  '¦r¨åª«¥óªºKey¤£¦s¦b
                row1 = wb.Sheets("¾Ç¥Í¸ê®Æ").Range("A65536").End(xlUp).Row + 1
                wb1.Sheets("¾Ç¥Í¸ê®Æ").Rows(R.Row).Copy wb.Sheets("¾Ç¥Í¸ê®Æ").Cells(row1, 1)
            End If
        Next
        On Error GoTo 0
        wb.Activate
        wb1.Activate
        wb1.Close False
        Set wb1 = Nothing
50
    Next
    MakeMenu
End Sub

yangjie

¦^´_ 2# GBKEE
¦ý§PŪ¬Û²§·Ç«h1~12Äæ copy¬O1~21Äæ

yangjie

¦^´_ 2# GBKEE
·P¿EGBKEE
1.
¦]¬° Äæ¦ì¦³21Äæ
¦ý§PŪ¬Û²§·Ç«h1~12Äæ copy¬O21Äæ
dictionary À³¦p¦ó¼g
  AR(i) = Sheets("100¦hµ§").UsedRange.Rows(1).Value
  For Each R In Sheets("100¦hµ§").UsedRange.Rows
          S = Join(Application.Transpose(Application.Transpose(R.Value)), ",")
          d(S) = ""
  Next
2.
   If d(1).exists(S) = False Then  '¦r¨åª«¥óªºKey¤£¦s¦b
            i = i + 1
            ReDim Preserve AR(i)
            AR(i) = R.Value
   End If
¨ä¤¤d(1)¬O¬Æ»ò?
3.
Sheets("Sheet3").[a1].Resize(i + 1, UBound(AR, 2)) = AR
  ¦p¦ó­×§ï¬°³Ì«á¤@¦C

GBKEE

¦^´_ 1# yangjie
1:100 ¦hµ§¸ê®Æ(²Ä¤@Äæ¦Ü²Ä¤Q¤GÄæ) ¾É¤J¦r¨åª«¥ó
2:¤ñ¹ï 1000¦hµ§¸ê®Æ(²Ä¤@Äæ¦Ü²Ä¤Q¤GÄæ)¤£¦b¦r¨åª«¥óªº¾É¤J°}¦C¤¤

1. Option Explicit
   
2. Sub EX()
   
3.     Dim d As Object, R As Range, S As String, AR(), i As Integer
   
4.     Set d = CreateObject("scripting.dictionary")  '³]¥ß¦r¨åª«¥ó
   
5.     ReDim Preserve AR(i)
   
6.     AR(i) = Sheets("100¦hµ§").UsedRange.Rows(1).Value
   
7.     For Each R In Sheets("100¦hµ§").UsedRange.Rows
   
8.         S = Join(Application.Transpose(Application.Transpose(R.Value)), ",")
   
9.         d(S) = ""
   
10.     Next
    
11.     For Each R In Sheets("1000¦hµ§").UsedRange.Rows
    
12.         S = Join(Application.Transpose(Application.Transpose(R.Value)), ",")
    
13.         If d.exists(S) = False Then  '¦r¨åª«¥óªºKey¤£¦s¦b
    
14.             i = i + 1
    
15.             ReDim Preserve AR(i)
    
16.             AR(i) = R.Value
    
17.         End If
    
18.     Next
    
19.     AR = Application.Transpose(Application.Transpose(AR))
    
20.     Sheets("Sheet3").[a1].Resize(i + 1, UBound(AR, 2)) = AR
    
21. End Sub

½Æ»s¥N½X