30/09/2018, 19:52

VBA - Tài liệu + Thảo luận

Chào mọi người,

Đó giờ e chỉ xem những video của a Đạt trên youtube thôi (chắc không để ý có diễn đàn) không ngờ a cũng có web hay thế này mà còn thiết kế đẹp nữa chứ.

Em cũng mới tạo acc trên diễn đàn nên xin tạo Topic này. Không biết là trước đây có topic nào như vầy chưa (search không thấy) nên thôi tạo cái cho máu.

Vào chủ đề thôi.

Chuyện là e đang thực tập ở FPT. Thì thấy ở đây các anh PM có một cái rất hay là VBA. Làm macro cho Excel. Làm cho excel trở thành một cái tool hổ trợ đắt lực.
Em đang thực tập trong dự án thiệt luôn và thấy có rất nhiều tool mà mọi người điều xài ví dụ như:

  • QA: xài tool lấy đường dẫn file trong thư mục, tại dự án lớn thì thư mục và tài liệu rất nhiều nên không thể mà vào từ folder kím và lấy thì rất mất thời gian. Và hẳn là khi lọc ra được thì chỉ cần nhấn nút là copy tất cả vào thư mục mình mong muốn.

  • CS(common solution): xài tool count số line của tài liệu khách hàng gửi để confirm với khách hàng. Thì tool sẽ vào từng file tài liệu (file excel) đếm số dòng trong đó và copy kết quà đó ra một template.

  • Dev: xài tool sẽ dựa trên dictionary de tạo ra coding ở dạng sườn cho coder.

Và còn còn rất nhiều tool nữa.

Nên topic này để mọi người có thể thảo luận, chia sẻ tài liệu về VBA cho nhau. Giúp nhau giải các vấn đề thực tế.

  • p/s: dân kinh tế rất ghiền cái này nhá nên có thể hợp tác làm ăn vs họ
Nguyen Minh Sang viết 21:54 ngày 30/09/2018

Chuyện là e đang thực tập ở FPT. Thì thấy ở đây các anh PM có một cái rất hay là VBA. Làm macro cho Excel. Làm cho excel trở thành một cái tool hổ trợ đắt lực.

em rất thích mảng này @@

Khanh Tran viết 22:00 ngày 30/09/2018

Mình đang cuồn đó bạn =))

Nguyen Minh Sang viết 21:58 ngày 30/09/2018

anh cho e link YT demo các dự án của a hoặc ý tưởng đc chứ a ?

Nguyen Ca viết 21:54 ngày 30/09/2018

Có đoạn code vba này hay dùng: tách sheet thành từng file

Sub Copy_Every_Sheet_To_New_Workbook()
'Working in 97-2013
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim sh As Worksheet
    Dim DateString As String
    Dim FolderName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    'Copy every sheet from the workbook with this macro
    Set Sourcewb = ThisWorkbook

    'Create new folder to save the new files in
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString
    MkDir FolderName

    'Copy every visible sheet to a new workbook
    For Each sh In Sourcewb.Worksheets

        'If the sheet is visible then copy it to a new workbook
        If sh.Visible = -1 Then
            sh.Copy

            'Set Destwb to the new workbook
            Set Destwb = ActiveWorkbook

            'Determine the Excel version and file extension/format
            With Destwb
                If Val(Application.Version) < 12 Then
                    'You use Excel 97-2003
                    FileExtStr = ".xls": FileFormatNum = -4143
                Else
                    'You use Excel 2007-2013
                    If Sourcewb.Name = .Name Then
                        MsgBox "Your answer is NO in the security dialog"
                        GoTo GoToNextSheet
                    Else
                        Select Case Sourcewb.FileFormat
                        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                        Case 52:
                            If .HasVBProject Then
                                FileExtStr = ".xlsm": FileFormatNum = 52
                            Else
                                FileExtStr = ".xlsx": FileFormatNum = 51
                            End If
                        Case 56: FileExtStr = ".xls": FileFormatNum = 56
                        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                        End Select
                    End If
                End If
            End With

            'Change all cells in the worksheet to values if you want
            If Destwb.Sheets(1).ProtectContents = False Then
                With Destwb.Sheets(1).UsedRange
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    .Cells(1).Select
                End With
                Application.CutCopyMode = False
            End If


            'Save the new workbook and close it
            With Destwb
                .SaveAs FolderName _
                      & "\" & Destwb.Sheets(1).Name & FileExtStr, _
                        FileFormat:=FileFormatNum
                .Close False
            End With

        End If
GoToNextSheet:
    Next sh

    MsgBox "You can find the files in " & FolderName

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
Khanh Tran viết 21:58 ngày 30/09/2018

Đa số những tool này được viết ra để để giải quyết một vấn đề thực tế trước mắt.
VD: có một anh trong team vừa làm ra một cái tool tự động chỉnh dòng, font size, màu chữ như theo template của khách hàng.
Vì các member phải vào từng file điền, tô màu chự, căng chỉnh lại thì khá mất thời gian.
Nên:
Chỉ cần điền thông tin vào đó như màu chữ là gì, font…v.v
Sau đó cho hàng loạt file path của các file cần chỉnh lại.
Nhấn OK là tất cả các file đó theo định dạnh.

  • Không biết bạn đã rành về VBA chưa nếu chưa mình có thể cho bạn một ý tưởng nho nhỏ để làm qen.
  • Còn đã biết đến nó thì mình cũng như bạn đang kiếm một đề tài thực tế để làm.
Khanh Tran viết 21:58 ngày 30/09/2018

Mình mới tham gia diễn đàn thôi.
Không biết là được up file đính kèm không nhĩ.
Đươc thì hay quá chứ post code kiu này dài quá mất thời gian cho các mem sau vào đọc.

Nguyen Ca viết 22:08 ngày 30/09/2018

không có up được đâu

Khanh Tran viết 22:06 ngày 30/09/2018

Ồ vậy thì khó nhĩ.
Như bạn vừa nãy cho 1 Sub thôi đã thấy khá dài rồi.

Bùi Hồng Sơn viết 22:01 ngày 30/09/2018

Bạn có thể up lên 1 bên thứ 3 nào đó r copy link down vào đây đc mà

Bài liên quan
0