Tối ưu code VBA (1 người xem)

duchuan299 · 17/5/20

Chào anh/chị trên diễn đàn Giải Pháp Excel. Em mới tập tành VBA, em có đoạn code sau nhờ anh/chị giúp chỉnh sửa đoạn code để tối ưu ạ hoặc nếu có cách nào viết hay hơn anh/chị hướng dẫn giúp em. Đoạn code này dùng để "liệt kê tên các file từ 1 folder được chọn". Em cám ơn.

Mã:

Sub Report()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    Dim sFldr As String

    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an instance of the FileSystemObject
    Range("B4:C100") = "" 'set up innitial condition
    sFldr = Select_folder() 'Call the ChooseFolder function
    If sFldr <> "" Then 'Check sFldr choose or not
        Set objFolder = objFSO.GetFolder(sFldr)
        i = 1
        'loops through each file in the directory and prints their ordinal numbers and file name
        For Each objFile In objFolder.Files
            Cells(i + 3, 2) = i  'print ordinal numbers
            Cells(i + 3, 3) = objFile.Name  'print filenames
            i = i + 1
        Next objFile
    End If
End Sub

Function Select_folder()
    Dim fldr As FileDialog
    Dim sItem As String
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    Select_folder = sItem
    Set fldr = Nothing
End Function

ppc0312 · 17/5/20

Như thế là được rồi, tối ưu chi nữa
Mấy cái này chạy veo cái là xong

ndu96081631 · 17/5/20

duchuan299 đã viết:

Chào anh/chị trên diễn đàn Giải Pháp Excel. Em mới tập tành VBA, em có đoạn code sau nhờ anh/chị giúp chỉnh sửa đoạn code để tối ưu ạ hoặc nếu có cách nào viết hay hơn anh/chị hướng dẫn giúp em. Đoạn code này dùng để "liệt kê tên các file từ 1 folder được chọn". Em cám ơn.

Mã:

Sub Report()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    Dim sFldr As String

    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an instance of the FileSystemObject
    Range("B4:C100") = "" 'set up innitial condition
    sFldr = Select_folder() 'Call the ChooseFolder function
    If sFldr <> "" Then 'Check sFldr choose or not
        Set objFolder = objFSO.GetFolder(sFldr)
        i = 1
        'loops through each file in the directory and prints their ordinal numbers and file name
        For Each objFile In objFolder.Files
            Cells(i + 3, 2) = i  'print ordinal numbers
            Cells(i + 3, 3) = objFile.Name  'print filenames
            i = i + 1
        Next objFile
    End If
End Sub

Function Select_folder()
    Dim fldr As FileDialog
    Dim sItem As String
  
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    Select_folder = sItem
    Set fldr = Nothing
End Function

1> Dùng mảng sẽ nhanh hơn rất nhiều so với việc gán giá trị vào từng cell.
2> Bạn "Dim i as Integer" là hơi chủ quan, khi biến i vượt quá số 32,767 thì code sẽ lỗi. Nên "Dim i as Long" sẽ chắc ăn hơn
3> Đoạn ".AllowMultiSelect = False" là thừa vì thực chắc có gán = True hay False thì bạn cũng chẳng bao giờ chọn được nhiều hơn 1 folder
4> Đoạn ".InitialFileName = strPath" cũng thừa luôn

VetMini · 17/5/20

Code của hàm Select_folder lấy từ trên mạng.
Và lấy ẩu cho nên thiếu một vài chi tiết:
1. bản chính của hàm này có tham strPath. Người cóp code cẩu thả không thấy điểm này, strPath vì thế coi như là biến, và có trị "".
Function Select_folder(strPath As String)
2. trên mạng có cho biết hàm này có thể khoá folder, và có đề nghị một vài kỹ thuật để chỉnh sửa.

Kết luận:
Thớt khoan vội nghĩ đến chuyện "tối ưu". Học cách cóp code cho đàng hoàng đã.

minhtuan55 · 17/5/20

VetMini đã viết:
Code của hàm Select_folder lấy từ trên mạng.
Và lấy ẩu cho nên thiếu một vài chi tiết:
1. bản chính của hàm này có tham strPath. Người cóp code cẩu thả không thấy điểm này, strPath vì thế coi như là biến, và có trị "".
Function Select_folder(strPath As String)
2. trên mạng có cho biết hàm này có thể khoá folder, và có đề nghị một vài kỹ thuật để chỉnh sửa.

Kết luận:
Thớt khoan vội nghĩ đến chuyện "tối ưu". Học cách cóp code cho đàng hoàng đã.

code này đơn giản 15 dòng là xong

VetMini · 17/5/20

Vậy thì chúc mừng thớt. Có cố vấn xịn rồi nhé, cứ việc bám theo mà xin "code tối ưu".

duchuan299 · 17/5/20

VetMini đã viết:
Code của hàm Select_folder lấy từ trên mạng.
Và lấy ẩu cho nên thiếu một vài chi tiết:
1. bản chính của hàm này có tham strPath. Người cóp code cẩu thả không thấy điểm này, strPath vì thế coi như là biến, và có trị "".
Function Select_folder(strPath As String)
2. trên mạng có cho biết hàm này có thể khoá folder, và có đề nghị một vài kỹ thuật để chỉnh sửa.

Kết luận:
Thớt khoan vội nghĩ đến chuyện "tối ưu". Học cách cóp code cho đàng hoàng đã.

Trước tiên, em cám ơn VetMini đã có nhận xét chính xác về đoạn code trên. Kế đến, yêu cầu nguyên bản của đoạn code là xuất tên file trong 1 folder và đường dẫn của file. Nhưng em có thay đổi chút yêu cầu là xuất tên file và đánh số thứ tự. Do vậy có xóa phần objFile.Path bên chương trình chính. Nhờ góp ý của VetMini, em biết thêm.

Bài đã được tự động gộp: 17/5/20

minhtuan55 đã viết:
code này đơn giản 15 dòng là xong

Em cám ơn góp ý của minhtuan55, do em mới tập tành VBA. Bác có cách nào khác, bác chỉ dùm em. Em cám ơn.

Bài đã được tự động gộp: 17/5/20

ndu96081631 đã viết:
1> Dùng mảng sẽ nhanh hơn rất nhiều so với việc gán giá trị vào từng cell.
2> Bạn "Dim i as Integer" là hơi chủ quan, khi biến i vượt quá số 32,767 thì code sẽ lỗi. Nên "Dim i as Long" sẽ chắc ăn hơn
3> Đoạn ".AllowMultiSelect = False" là thừa vì thực chắc có gán = True hay False thì bạn cũng chẳng bao giờ chọn được nhiều hơn 1 folder
4> Đoạn ".InitialFileName = strPath" cũng thừa luôn

Em cám ơn ý kiên của bác ndu96081631. Em đã chỉnh lại code như mục 2,3 và 4. Còn mục 1, em không biết code như bác đã hướng dẫn do em còn gà lắm. Mong bác chỉ cụ thể thêm. Sau đây là code em đã chỉnh lại

Mã:

Sub Report()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Long
    Dim sFldr As String

    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an instance of the FileSystemObject
    Range("B4:C100") = "" 'set up innitial condition
    sFldr = Select_folder() 'Call the ChooseFolder function
    If sFldr <> "" Then 'Check sFldr choose or not
        Set objFolder = objFSO.GetFolder(sFldr)
        i = 1
        'loops through each file in the directory and prints their ordinal numbers and file name
        For Each objFile In objFolder.Files
            Cells(i + 3, 2) = i  'print ordinal numbers
            Cells(i + 3, 3) = objFile.Name  'print filenames
            i = i + 1
        Next objFile
    End If
End Sub

Function Select_folder()
    Dim fldr As FileDialog
    Dim sItem As String
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    Select_folder = sItem
    Set fldr = Nothing
End Function

VetMini · 18/5/20

Chỉ có lấy tên files và ghi ra bảng tính thôi thì tại sao phải cần "tối ưu"
Mấy công việc lặt vặt này thì chỉ cần lưu ý kết quả. Chạy ra đúng kết quả là tốt rồi.

be_09 · 18/5/20

duchuan299 đã viết:
Chào anh/chị trên diễn đàn Giải Pháp Excel. Em mới tập tành VBA, em có đoạn code sau nhờ anh/chị giúp chỉnh sửa đoạn code để tối ưu ạ hoặc nếu có cách nào viết hay hơn anh/chị hướng dẫn giúp em. Đoạn code này dùng để "liệt kê tên các file từ 1 folder được chọn". Em cám ơn.

Không biết mục đích của bạn lấy tên File trong 1 Folder để làm cái gì?
Tại sao không lấy tên File xong thì tạo HyperLink luôn, khi tìm đến File đó và click vào tên File thì mở File đó lên cho tiện.
Theo tôi thì mở hộp thoại lên và chọn bất kỳ Folder nào đó để lấy tên File.

VetMini · 18/5/20

be09 đã viết:
Không biết mục đích của bạn lấy tên File trong 1 Folder để làm cái gì?
...

Thớt chỉ muốn tập viết code thôi.
Rất tiếc là chọn đề tài này không thực dụng lắm.

"tối ưu" là từ mang đầy tính chất chủ quan và tương đối. Đối với phần lớn người trên diễn đàn này thì "tối ưu" gắn liền với tốc độ chạy code. Đối với một thiểu số như tôi thì đặt quan trọng hơn trong việc code dễ chỉnh sửa và kiểm soát.
Lại còn có một vài người như tác giả bài #5, chú trọng về biễu diễn số dòng.

ndu96081631 · 18/5/20

duchuan299 đã viết:

Em cám ơn ý kiên của bác ndu96081631. Em đã chỉnh lại code như mục 2,3 và 4. Còn mục 1, em không biết code như bác đã hướng dẫn do em còn gà lắm. Mong bác chỉ cụ thể thêm. Sau đây là code em đã chỉnh lại

Mã:

Sub Report()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Long
    Dim sFldr As String

    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an instance of the FileSystemObject
    Range("B4:C100") = "" 'set up innitial condition
    sFldr = Select_folder() 'Call the ChooseFolder function
    If sFldr <> "" Then 'Check sFldr choose or not
        Set objFolder = objFSO.GetFolder(sFldr)
        i = 1
        'loops through each file in the directory and prints their ordinal numbers and file name
        For Each objFile In objFolder.Files
            Cells(i + 3, 2) = i  'print ordinal numbers
            Cells(i + 3, 3) = objFile.Name  'print filenames
            i = i + 1
        Next objFile
    End If
End Sub

Function Select_folder()
    Dim fldr As FileDialog
    Dim sItem As String
   
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    Select_folder = sItem
    Set fldr = Nothing
End Function

Sửa thành vầy sẽ nhanh hơn:

Mã:

Sub Report()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Long
    Dim sFldr As String

    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an instance of the FileSystemObject
    Range("B4:C100") = "" 'set up innitial condition
    sFldr = Select_folder() 'Call the ChooseFolder function
    If sFldr <> "" Then 'Check sFldr choose or not
        Set objFolder = objFSO.GetFolder(sFldr)
'        i = 1
'        'loops through each file in the directory and prints their ordinal numbers and file name
'        For Each objFile In objFolder.Files
'            Cells(i + 3, 2) = i  'print ordinal numbers
'            Cells(i + 3, 3) = objFile.Name  'print filenames
'            i = i + 1
'        Next objFile
        Dim lCount As Long
        lCount = objFolder.Files.Count
        ReDim aDes(1 To lCount, 1 To 2)
        If lCount Then
            For Each objFile In objFolder.Files
              i = i + 1
              aDes(i, 1) = i
              aDes(i, 2) = objFile
            Next
            Range("B4").Resize(lCount, 2).Value = aDes
        End If
    End If
End Sub

duchuan299 · 18/5/20

ndu96081631 đã viết:

Sửa thành vầy sẽ nhanh hơn:

Mã:

Sub Report()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Long
    Dim sFldr As String

    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Create an instance of the FileSystemObject
    Range("B4:C100") = "" 'set up innitial condition
    sFldr = Select_folder() 'Call the ChooseFolder function
    If sFldr <> "" Then 'Check sFldr choose or not
        Set objFolder = objFSO.GetFolder(sFldr)
'        i = 1
'        'loops through each file in the directory and prints their ordinal numbers and file name
'        For Each objFile In objFolder.Files
'            Cells(i + 3, 2) = i  'print ordinal numbers
'            Cells(i + 3, 3) = objFile.Name  'print filenames
'            i = i + 1
'        Next objFile
        Dim lCount As Long
        lCount = objFolder.Files.Count
        ReDim aDes(1 To lCount, 1 To 2)
        If lCount Then
            For Each objFile In objFolder.Files
              i = i + 1
              aDes(i, 1) = i
              aDes(i, 2) = objFile
            Next
            Range("B4").Resize(lCount, 2).Value = aDes
        End If
    End If
End Sub

Em cám ơn bác ndu96081631 rất nhiều

duchuan299 · 18/5/20

VetMini đã viết:
Thớt chỉ muốn tập viết code thôi.
Rất tiếc là chọn đề tài này không thực dụng lắm.

"tối ưu" là từ mang đầy tính chất chủ quan và tương đối. Đối với phần lớn người trên diễn đàn này thì "tối ưu" gắn liền với tốc độ chạy code. Đối với một thiểu số như tôi thì đặt quan trọng hơn trong việc code dễ chỉnh sửa và kiểm soát.
Lại còn có một vài người như tác giả bài #5, chú trọng về biễu diễn số dòng.

Bác VetMini nói chính xác. Em đang học code qua các ví dụ. Rất hiệu quả khi cùng thảo luận về vấn đề này. Cám ơn bác đã chỉ ra.

Bài đã được tự động gộp: 18/5/20

be09 đã viết:
Không biết mục đích của bạn lấy tên File trong 1 Folder để làm cái gì?
Tại sao không lấy tên File xong thì tạo HyperLink luôn, khi tìm đến File đó và click vào tên File thì mở File đó lên cho tiện.
Theo tôi thì mở hộp thoại lên và chọn bất kỳ Folder nào đó để lấy tên File.

Chào bác be09 nguyên nhân là em đang học cách dùng VBA list ra tên của file trong folder. Sau đó, em muốn biết thêm cách viết khác nên mang lên diễn đàn để thảo luận. Cám ơn bác be09 đã tham gia.

duchuan299 · 18/5/20

Rất vui khi khi các bác dành thời gian phản hồi ý kiến. Em được học thêm cách viết khác. Em cám ơn các bác đã tham gia đóng góp ý kiến giúp em Em xin đóng chủ đề này tại đây. . Chân thành cám ơn.

VetMini · 18/5/20

Đóng chi sớm vậy. Đợi tác giả bài #5 "đơn giản 15 dòng" xem sao?

be_09 · 18/5/20

VetMini đã viết:
Đóng chi sớm vậy. Đợi tác giả bài #5 "đơn giản 15 dòng" xem sao?

Tôi ráng hết cỡ thì toàn bộ code cũng đến 16 dòng (vậy là vẫn thua 1 dòng).

Hau151978 · 19/5/20

Code gần đủ 15 dòng

Mã:

Sub xxx()
    Dim Dlg As FileDialog, x, i As Long
    if Application.FileDialog(msoFileDialogFolderPicker).Show=0 then Exit Sub
    Columns(1).Clear
    For Each x In CreateObject("Scripting.FileSystemObject").GetFolder(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)).Files
        i = i + 1
        Cells(i, 1) = x.Name
    Next
End Sub

VetMini · 19/5/20

be09 đã viết:
Tôi ráng hết cỡ thì toàn bộ code cũng đến 16 dòng (vậy là vẫn thua 1 dòng).
...

Hau151978 đã viết:
Code gần đủ 15 dòng
...

Tại quý vị không nhớ rõ về người nói. Con số 15 dòng là gần như bài nào cũng vậy, nó từ trên trời rớt xuống, không qua một lô gic tính toán nào cả.
Thế giới ảo mà. Nói trước làm sau. Không làm được thì cóp một đoạn code Xê Cọng Cọng hay một cái hình mạch điện gì đó đưa lên cho thiên hạ hết hồn.

truongvu317 · 19/5/20

Hau151978 đã viết:

Code gần đủ 15 dòng

Mã:

Sub xxx()
    Dim Dlg As FileDialog, x, i As Long
    if Application.FileDialog(msoFileDialogFolderPicker).Show=0 then Exit Sub
    Columns(1).Clear
    For Each x In CreateObject("Scripting.FileSystemObject").GetFolder(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)).Files
        i = i + 1
        Cells(i, 1) = x.Name
    Next
End Sub

Dùng dấu ":" gộp mấy dòng làm một, có khi chỉ khoảng 5 6 dòng gì đó.

Bài đã được tự động gộp: 19/5/20

VetMini đã viết:
Không làm được thì cóp một đoạn code Xê Cọng Cọng hay một cái hình mạch điện gì đó đưa lên cho thiên hạ hết hồn.

Đó là một loại võ công thượng thừa thừa thừa đó bác. Không phải ai cũng làm được đâu bác.

VetMini · 19/5/20

Chả có thừa thiếu gì ở đây cả.

Cóp văn của người khác đem ra khoe là đạo văn. Cóp code (không bản quyền) của người khác đem ra khoe thì phải dẫn nguồn. Không dẫn nguồn là mặt dầy.
Cóp code có bản quyền là phạm pháp.

Tối ưu code VBA (1 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

whom?

Huyền thoại GPE

Đang đi tìm hòn đá

Thành viên bị đình chỉ hoạt động

Đang đi tìm hòn đá

Thành viên mới

Đang đi tìm hòn đá

Biên Hòa, Đồng Nai

Đang đi tìm hòn đá

Huyền thoại GPE

Thành viên mới

Thành viên mới

Thành viên mới

Đang đi tìm hòn đá

Biên Hòa, Đồng Nai

Thành viên tích cực

Đang đi tìm hòn đá

Thành viên tích cực

Đang đi tìm hòn đá

Thời gian đếm ngược.