ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

VBA §ì¨úListBox¤¤ªº¤º®e

¦^´_ 40# samwang
¨º¦pªGª½±µ§â¾÷1¡B¾÷2¨º­Ó¸ê®Æ§¨·í¹w³]ªº¸ê®Æ§¨©O¡H

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-7-6 20:20 ½s¿è

¦^´_ 41# wang077

ÁÙ¬O¦³°ÝÃD¡A¦]¬°µLªk±oª¾¾÷1¾÷2ªº¸ô®|¡A©Ò¥HµLªk¶}±ÒÀɮסA°£«D¬O©T©w¸ô®|©Î»Pµ{¦¡Àɮשñ¦P¤@­Ó¸ô®|¡A
¥t¥~±z10¼Ó»¡¦³¦n¦h­Ó¾÷¥x¡A¨º¬°¤°»ò²{¦b¥u¦³¹w³]¾÷1¾÷2?¬O¥t¥~»Ý¨D¶Ü?

TOP

¦^´_ 42# samwang
¦]¬°¾÷1¡A¾÷2¬O§Ú§ì¥X¨Ó·í½d¨Ò¥Î¡A¤§«á¦pªG§¹¦¨ÁÙ·|¥[¤J§ó¦h
¨º¦pªG¸ê®Æ§¨ªº¸ô®|¬O©T©wªº¡AÀɮפ]³£©T©w©ñ¦b¸ê®Æ§¨ùتº¸Ü©O?

TOP

¦^´_ 43# wang077

´£¨Ñ2ºØ¤èªk¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub UserForm_Activate()
Dim fs, f, fc, xD, a
Set fs = CreateObject("Scripting.FileSystemObject")
Set xD = CreateObject("Scripting.Dictionary")
'a = ThisWorkbook.Path  'µ{¦¡ÀÉ»P¸ê®ÆÀÉ©ñ¦P¤@­Ó¸ê®Æ§¨
a = "D:\test"                       '¸ê®ÆÀÉ©ñ¦b©T©w¸ô®|
fnorg = ActiveWorkbook.Name
Set f = fs.GetFolder(a)
Set fc = f.Files
For Each f1 In fc
    n = n + 1
    If InStr(f1.Path, fnorg) Then GoTo 99
    Arr(n, 1) = f1.Path
    Arr(n, 2) = Split(f1.Name, ".")(0)
    xD(Arr(n, 2) & "") = ""
99: Next
Me.ListBox1.List = xD.keys
Set fs = Nothing: Set f = Nothing: Set fc = Nothing: Set xD = Nothing
EndSub:
End Sub

TOP

¦^´_ 44# samwang
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
fileorg = ActiveWorkbook.Name
Set xD = CreateObject("Scripting.Dictionary")
For i1 = 1 To n1
    If Not xD.Exists(Ar(i1, 1) & "") Then
        xD(Ar(i1, 1) & "") = ""
        For i = 1 To n
            If Arr(i, 2) = Ar(i1, 1) Then n2 = n2 + 1: Ar1(n2, 1) = Arr(i, 1)
        Next
    End If
Next
R = 1: Sheets("6¤ë¥÷¼Æ¾Ú").Select
With Sheets("6¤ë¥÷¼Æ¾Ú")
    If .FilterMode Then .ShowAllData
    .Range("a1:AA" & .[a65536].End(3).Row).Delete
    Tm = Timer
    For i1 = 1 To n2
        Set WB = Workbooks.Open(Ar1(i1, 1))
        With Sheets("6¤ë¥÷¼Æ¾Ú")
            If .FilterMode Then .ShowAllData
            fn = Split(ActiveWorkbook.Name, ".")(0)
            .Range("a1:z" & .[a65536].End(3).Row).Copy Workbooks(fileorg).Sheets("6¤ë¥÷¼Æ¾Ú").Range("a" & R)
        End With
        WB.Close
        .Range("U" & R & ":U" & .[a65536].End(xlUp).Row) = fn
        R = .[a65536].End(xlUp).Row + 1
    Next
End With
MsgBox "¸ê®Æ½Æ»s§¹¦¨" & Timer - Tm & "¬í"
Erase Arr: Erase Ar
Unload Me

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

½Æ»s¸ê®Æªº®É­Ô
Set WB = Workbooks.Open(Ar1(i1, 1))
³o¦æ¥X²{¤F¿ù»~

TOP

¦^´_ 45# wang077
§ä¨ì¿ù»~¤F¡A­è­è§âµ{¦¡ÀÉ©ñ¦A¦P¤@­Ó¸ê®Æ§¨¡A©Ò¥H¥X²{¿ù»~
¥H¸Ñ¨M³o¿ù»~

TOP

¦^´_ 1# wang077
  1. With ListBox1
  2.           .ListStyle = 1  '§Ç«e¤è®Ø®Ø
  3. End With
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ wang077 ©ó 2021-7-7 10:40 ½s¿è

¦^´_ 44# samwang
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
fileorg = ActiveWorkbook.Name
Set xD = CreateObject("Scripting.Dictionary")
For i1 = 1 To n1
    If Not xD.Exists(Ar(i1, 1) & "") Then
        xD(Ar(i1, 1) & "") = ""
        For i = 1 To n
            If Arr(i, 2) = Ar(i1, 1) Then n2 = n2 + 1: Ar1(n2, 1) = Arr(i, 1)
        Next
    End If
Next
R = 1: Sheets("6¤ë¥÷¼Æ¾Ú").Select
With Sheets("6¤ë¥÷¼Æ¾Ú")
    If .FilterMode Then .ShowAllData
    .Range("a1:AA" & .[a65536].End(3).Row).Delete
    Tm = Timer
    For i1 = 1 To n2
        Set WB = Workbooks.Open(Ar1(i1, 1))
        With Sheets("6¤ë¥÷¼Æ¾Ú")
            If .FilterMode Then .ShowAllData
            fn = Split(ActiveWorkbook.Name, ".")(0)
            .Range("a1:z" & .[a65536].End(3).Row).Copy Workbooks(fileorg).Sheets("6¤ë¥÷¼Æ¾Ú").Range("a" & R)
        End With
        WB.Close
        .Range("U" & R & ":U" & .[a65536].End(xlUp).Row) = fn
        R = .[a65536].End(xlUp).Row + 1
    Next
End With
MsgBox "¸ê®Æ½Æ»s§¹¦¨" & Timer - Tm & "¬í"
Erase Arr: Erase Ar

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub

   


¤j¤j¡A§Ú§â½Æ»s¸ê®Æªºµ{¦¡½X¥á¶i¥hListBox1_DblClick¸Ì­±
¥i¥Hª½±µ¿ï¨úListBox¨Ó¥s¥X¸ê®Æ¡A¦ý§Ú¦pªG²Ä¤@¦¸ÂIÀ»¾÷1¥i¥H¥s¥X¾÷1ªº¸ê®Æ¡A§Ú²Ä¤G¦¸ÂIÀ»¾÷2ªº®É­Ô
¥L¤SÅã¥Ü³o¿ù»~¤F
¨D¸Ñ¡I

TOP

¦^´_ 47# s3526369
¦¹°ÝÃD¤w¸Ñ¨M
·PÁ¤À¨É

TOP

¦^´_ 48# wang077


§Ú´ú¸Õ¨S°ÝÃD¡A¥iªþ¥óÅý§Ú´ú¸Õ¬Ý¬Ý¶Ü? ÁÂÁÂ

TOP

        ÀR«ä¦Û¦b : ¡i®É¶¡µLªk¾B¾×¡j©È®É¶¡®ø³u¡Aªá¤F³\¦h¤ß¦å¡A·QºÉ¦U¦¡¤èªk­n¾B¾×®É¶¡¡Aµ²ªG¬O¡G®ö¶O¤F§ó¦h®É¶¡¡A¥B¤@µL©Ò¦¨¡I
ªð¦^¦Cªí ¤W¤@¥DÃD