[已解决]指定幾個文件筛选，并把結果显示到另一個文件里面！。。急

c805971855c

zjdh 发表于 2012-6-3 12:51
你怎么求助像挤牙膏似的？！！

太感谢你了，组要没见过你这样的高手，怕搞多功能了，拍没人回帖子，还有个问题，筛选列号能不能无限增加，筛选那个键怎么移动呀

zjdh

什么叫：筛选列号能不能无限增加
移动按钮：

c805971855c

zjdh 发表于 2012-6-3 14:45
什么叫：筛选列号能不能无限增加
移动按钮：

就是筛选列号最后一个不是Z吗，可不可以增加AA,AB,AC。。。。

zjdh

c805971855c 发表于 2012-6-3 15:14
就是筛选列号最后一个不是Z吗，可不可以增加AA,AB,AC。。。。

那只是方便输入，超过Z列的直接输入就可以啦！

c805971855c

zjdh 发表于 2012-6-3 15:24
那只是方便输入，超过Z列的直接输入就可以啦！

太感谢你了，找个功能都搞了半个月了，能不能加个好友呀

c805971855c

zjdh 发表于 2012-6-3 15:24
那只是方便输入，超过Z列的直接输入就可以啦！

請問一下，我到公司來打開文件夾為什麽顯示找不到檔，我這邊是繁體系統（台灣），還有程序怎麼看不到呀

zjdh

c805971855c 发表于 2012-6-4 08:05
請問一下，我到公司來打開文件夾為什麽顯示找不到檔，我這邊是繁體系統（台灣），還有程序怎麼看不到呀

那肯定是系统问题，我没有繁体系统，无法测试。
你要注意2点：
1.  文件必须解压到需要筛选的文件所在文件夹。
2.  要引用Microsoft Windows Common Controls 6.0 (SP6)控件

zjdh

程序在窗体中：
点窗体--选择--右键查看代码

c805971855c

zjdh 发表于 2012-6-4 13:12
程序在窗体中：
点窗体--选择--右键查看代码

別人幫我改了一下程序，可是我不知道怎麼測試
Private Sub CheckBox1_Click()
    With ListView1
        If CheckBox1 = True Then
            For I = 1 To .ListItems.Count
                .ListItems(I).Checked = True
            Next
        Else
            For I = 1 To .ListItems.Count
                .ListItems(I).Checked = False
            Next
        End If
    End With
End Sub
Private Sub CommandButton1_Click()
    Unload Me
End Sub
Private Sub CommandButton2_Click()
    Dim ARR()
    If TextBox1 = "" Then MsgBox "你尚未設定篩選內容！": Exit Sub
    If ComboBox1 = "" Then MsgBox "你尚未設定篩選列號！": Exit Sub
    With ListView1
        For I = 1 To .ListItems.Count
            If .ListItems(I).Checked = True Then
                K = K + 1
                ReDim Preserve ARR(1 To K)
                ARR(K) = .ListItems(I).SubItems(1)
            End If
        Next
    End With
    If K = "" Then MsgBox "你尚未選擇工作簿！": Exit Sub
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    LH = ComboBox1 & ":" & ComboBox1
    myPath = ThisWorkbook.Path & "\"
    With ThisWorkbook.Sheets(1)
        .Range("A2:F65536").Delete
        For I = 1 To UBound(ARR)
            Set WB = GetObject(myPath & ARR(I) & ".xls")
            Set W = WB.Sheets(1).Range(LH).Find(TextBox1.Value, LookIn:=xlValues, lookAT:=xlWhole)
            If Not W Is Nothing Then
                firstAddress = W.Address
                Do
                    WB.Sheets(1).Rows(W.Row).Copy .Range("A65536").End(3)(2)
                    Set W = WB.Sheets(1).Range(LH).FindNext(W)
                Loop While Not W Is Nothing And W.Address <> firstAddress
            End If
            WB.Close False
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
10  Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim ITM As ListItem
    myPath = ThisWorkbook.Path & "\"
    fileName$ = Dir(myPath & "*.xls")
    While fileName$ <> ""
        If fileName <> ThisWorkbook.Name Then
            I = I + 1
            Set ITM = ListView1.ListItems.Add()
            ITM.Text = I
            ITM.SubItems(1) = Split(fileName, ".")(0)
        End If
        fileName = Dir
    Wend
    Set ITM = Nothing
    For I = 1 To 26
    ComboBox1.AddItem Chr(I + 64)
    Next
    TextBox1.SetFocus
End Sub

c805971855c

zjdh 发表于 2012-6-4 13:12
程序在窗体中：
点窗体--选择--右键查看代码

這個是英文的
Private Sub CheckBox1_Click()
    With ListView1
        If CheckBox1 = True Then
            For I = 1 To .ListItems.Count
                .ListItems(I).Checked = True
            Next
        Else
            For I = 1 To .ListItems.Count
                .ListItems(I).Checked = False
            Next
        End If
    End With
End Sub
Private Sub CommandButton1_Click()
    Unload Me
End Sub
Private Sub CommandButton2_Click()
    Dim ARR()
    If TextBox1 = "" Then MsgBox  ChrW(20320) & ChrW(23578) & ChrW(26410) & ChrW(35373) & ChrW(23450) & ChrW(31721) & ChrW(36984) & ChrW(20839) & ChrW(23481) & ChrW(65281): Exit Sub   '你尚未設定篩選內容！
    If ComboBox1 = "" Then MsgBox  ChrW(20320) & ChrW(23578) & ChrW(26410) & ChrW(35373) & ChrW(23450) & ChrW(31721) & ChrW(36984) & ChrW(21015) & ChrW(34399) & ChrW(65281): Exit Sub   '你尚未設定篩選列號！
    With ListView1
        For I = 1 To .ListItems.Count
            If .ListItems(I).Checked = True Then
                K = K + 1
                ReDim Preserve ARR(1 To K)
                ARR(K) = .ListItems(I).SubItems(1)
            End If
        Next
    End With
    If K = "" Then MsgBox  ChrW(20320) & ChrW(23578) & ChrW(26410) & ChrW(36984) & ChrW(25799) & ChrW(24037) & ChrW(20316) & ChrW(31807) & ChrW(65281): Exit Sub   '你尚未選擇工作簿！
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    LH = ComboBox1 & ":" & ComboBox1
    myPath = ThisWorkbook.Path & "\"
    With ThisWorkbook.Sheets(1)
        .Range("A2:F65536").Delete
        For I = 1 To UBound(ARR)
            Set WB = GetObject(myPath & ARR(I) & ".xls")
            Set W = WB.Sheets(1).Range(LH).Find(TextBox1.Value, LookIn:=xlValues, lookAT:=xlWhole)
            If Not W Is Nothing Then
                firstAddress = W.Address
                Do
                    WB.Sheets(1).Rows(W.Row).Copy .Range("A65536").End(3)(2)
                    Set W = WB.Sheets(1).Range(LH).FindNext(W)
                Loop While Not W Is Nothing And W.Address <> firstAddress
            End If
            WB.Close False
        Next
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
10  Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim ITM As ListItem
    myPath = ThisWorkbook.Path & "\"
    fileName$ = Dir(myPath & "*.xls")
    While fileName$ <> ""
        If fileName <> ThisWorkbook.Name Then
            I = I + 1
            Set ITM = ListView1.ListItems.Add()
            ITM.Text = I
            ITM.SubItems(1) = Split(fileName, ".")(0)
        End If
        fileName = Dir
    Wend
    Set ITM = Nothing
    For I = 1 To 26
    ComboBox1.AddItem Chr(I + 64)
    Next
    TextBox1.SetFocus
End Sub