Giúp em lấy dữ liệu từ các file nằm ở các folder khác nhau theo đường dẫn (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
V

vonguyen3745

Thành viên hoạt động
Tham gia
18/7/09
Bài viết
145
Được thích
5
Em có các file nằm ở các thư mục khác nhau, muốn lấy dữ liệu về 1 file tổng hợp. Các file này có sẵn đường dẫn, sheets cần lấy và vùng cần lấy dữ liệu. Thanks
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
vonguyen3745 đã viết:
Em có các file nằm ở các thư mục khác nhau, muốn lấy dữ liệu về 1 file tổng hợp. Các file này có sẵn đường dẫn, sheets cần lấy và vùng cần lấy dữ liệu. Thanks
Nhấp chuột vào đây để mở rộng...
Chạy sub
Mã: 
Sub ABC()
  Dim sArr(), cn As Object, fRow&
  With Sheets("Sheet1")
    sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
  End With
  Set cn = CreateObject("ADODB.Connection")
  On Error Resume Next
  With Sheets("Sheet2")
    For i = 1 To UBound(sArr)
      fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sArr(i, 1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
      .Range("A" & fRow).CopyFromRecordset cn.Execute("select * from [" & sArr(i, 2) & "$" & sArr(i, 3) & "] where f1 is not null")
      cn.Close
    Next i
  End With
  Set cn = Nothing
End Sub
 
Upvote 0
Thanks bác HieuCD! Em muốn lấy thêm tên fie để biết dữ liệu đó từ file nào được không bác. Cảm ơn bác rất nhiều ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
vonguyen3745 đã viết:
Thanks bác HieuCD! Em muốn lấy thêm tên fie để biết dữ liệu đó từ file nào được không bác. Cảm ơn bác rất nhiều ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thử thế này:
SQL: 
Sub ABC()
  Dim sArr(), cn As Object, fRow&
  With Sheets("Sheet1")
    sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
  End With
  Set cn = CreateObject("ADODB.Connection")
  On Error Resume Next
  With Sheets("Sheet2")
    For i = 1 To UBound(sArr)
      fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sArr(i, 1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
      .Range("A" & fRow).CopyFromRecordset cn.Execute("select *,'" & sArr(i, 1) & "' from [" & sArr(i, 2) & "$" & sArr(i, 3) & "] where f1 is not null")
      cn.Close
    Next i
  End With
  Set cn = Nothing
End Sub
 
Upvote 0
quick87 đã viết:
Bạn thử thế này:
SQL: 
Sub ABC()
  Dim sArr(), cn As Object, fRow&
  With Sheets("Sheet1")
    sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
  End With
  Set cn = CreateObject("ADODB.Connection")
  On Error Resume Next
  With Sheets("Sheet2")
    For i = 1 To UBound(sArr)
      fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sArr(i, 1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
      .Range("A" & fRow).CopyFromRecordset cn.Execute("select *,'" & sArr(i, 1) & "' from [" & sArr(i, 2) & "$" & sArr(i, 3) & "] where f1 is not null")
      cn.Close
    Next i
  End With
  Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cái này nếu sheets 2 có dữ liệu nó không ghi đè lên bác nhỉ, khi các file họ cập nhật số liệu, mình muốn lấy dữ liệu mới không được, em muốn sheet 2 có dữ liệu rồi nó ghi đè lên dữ liệu cũ khi mình chạy code được không bác.
 
Upvote 0
vonguyen3745 đã viết:
Cái này nếu sheets 2 có dữ liệu nó không ghi đè lên bác nhỉ, khi các file họ cập nhật số liệu, mình muốn lấy dữ liệu mới không được, em muốn sheet 2 có dữ liệu rồi nó ghi đè lên dữ liệu cũ khi mình chạy code được không bác.
Nhấp chuột vào đây để mở rộng...

Bạn chỉnh lại điều kiện ở sheet1 là được mà ?
1626597863798.png

Code đã tự động điền giá trị cần lấy và nối tiếp dòng cuối cùng rồi.
 
Upvote 0
- Ý em là ở sheet đích, nếu có sẵn dữ liệu rồi thì code nó không copy đè lên dữ liệu ở đó.
- Em muốn chỉnh ô đầu tiên dán dữ liệu thì chỉnh thế nào bác, nó mặc định là ô A2, nhiều khi phần tiêu đề nó có 3-4 dòng thì lại không chạy được
 
Lần chỉnh sửa cuối:
Upvote 0
1.jpeg
Em chỉnh ô bắt đầu paste dữ liệu ở chỗ dánh dấu kia thì dữ liệu sau khi gộp từ các file nó lại có khoảng trống,
 
Lần chỉnh sửa cuối:
Upvote 0
vonguyen3745 đã viết:
Em có các file nằm ở các thư mục khác nhau, muốn lấy dữ liệu về 1 file tổng hợp. Các file này có sẵn đường dẫn, sheets cần lấy và vùng cần lấy dữ liệu. Thanks
Nhấp chuột vào đây để mở rộng...
Một cách làm khác, bạn tham khảo thêm:

Mã: 
Option Explicit

Dim sFile  As String
Sub DataLink(ByRef cell_ As Range, ByVal sLink As String, ByVal sFileName As String)
    On Error GoTo Err_
    cell_.FormulaArray = sLink: cell_.Value = cell_.Value
    If Len(sFile) = 0 Then sFile = sFileName Else sFile = sFile & vbNewLine & sFileName
Err_:
End Sub

Sub RunMe()

    Dim sheet As Worksheet, start_cell As Range, cell_ As Range, str As String, tmp
    Dim sFolder As String, sFileName As String, sShName As String, sRange As String
    Dim sLink As String
    
    Application.ScreenUpdating = False
    Set sheet = Sheet2: sheet.Cells.ClearContents
    Set start_cell = Sheet1.Range("A2")
    sFile = Empty
    Do Until start_cell.Value = ""
        str = start_cell.Value
        tmp = Split(str, "\")
        sFileName = tmp(UBound(tmp))
        sFolder = Mid(str, 1, Len(str) - Len(sFileName) - 1)
        If Len(Dir(sFolder & "\" & sFileName)) > 0 Then
            sShName = start_cell.Offset(, 1).Value
            sRange = start_cell.Offset(, 2).Value
            Set cell_ = sheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
            Set cell_ = cell_.Resize(sheet.Range(sRange).Rows.Count, sheet.Range(sRange).Columns.Count)
            sLink = "='" & sFolder & "\[" & sFileName & "]" & sShName & "'!" & sRange & ""
            DataLink cell_, sLink, sFileName
        End If
        Set start_cell = start_cell.Offset(1)
    Loop
    
    Application.ScreenUpdating = True
    sheet.Activate
    
    If Len(sFile) > 0 Then
        sFile = "File link OK:" & vbNewLine & sFile
    End If
    
    MsgBox "Kêt thúc " & vbNewLine & sFile, vbOKOnly + vbInformation
    
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
vonguyen3745 đã viết:
Khi em chạy code của bác

Hoàng Nhật Phương nó tạo ra dãy số 0 xen giữa các dòng dữ liệu; em không biết dãy đó ở đâu ra nhỉ:​

View attachment 262685
Nhấp chuột vào đây để mở rộng...
Chào Bạn, trong Sub RunMe , Bạn thử sửa dòng:
Mã: 
sLink = "='" & sFolder & "\[" & sFileName & "]" & sShName & "'!" & sRange & ""
Thành:
Mã: 
sLink = "'" & sFolder & "\[" & sFileName & "]" & sShName & "'!" & sRange & ""
sLink = "=IF(" & sLink & "<>""""," & sLink & ","""")"
 
Upvote 0
1.jpeg
OK rồi bạn, mình không muốn paste dữ liệu bắt đầu từ ô A2, mình muốn paste bắt đầu từ ô A4 thì chỉnh thế nào bạn nhỉ?
 
Upvote 0
vonguyen3745 đã viết:
View attachment 262694
OK rồi bạn, mình không muốn paste dữ liệu bắt đầu từ ô A2, mình muốn paste bắt đầu từ ô A4 thì chỉnh thế nào bạn nhỉ?
Nhấp chuột vào đây để mở rộng...
Bạn thử lại RunMe sau:
Mã: 
Sub RunMe()

    On Error GoTo Loi_roi:

    Application.ScreenUpdating = False
    Dim sheet As Worksheet, start_cell As Range, cell_ As Range, str As String, tmp, r As Long
    Dim sFolder As String, sFileName As String, sShName As String, sRange As String, sLink As String
    
    Const tenfile_batdau As String = "A2"
    Const oghidulieu_dautien As String = "A4"
    Const shGhiDuLieu As String = "Sheet2"
    sFile = Empty
    
    Set sheet = ThisWorkbook.Worksheets(shGhiDuLieu)
    sheet.Cells.ClearContents
    Set start_cell = Sheet1.Range(tenfile_batdau)
    
    Do Until start_cell.Value = ""
        str = start_cell.Value
        tmp = Split(str, "\")
        sFileName = tmp(UBound(tmp))
        sFolder = Mid(str, 1, Len(str) - Len(sFileName) - 1)
        If Len(Dir(sFolder & "\" & sFileName)) > 0 Then
            sShName = start_cell.Offset(, 1).Value
            sRange = start_cell.Offset(, 2).Value
            r = sheet.Range("A" & Rows.Count).End(xlUp).Row
            If r < sheet.Range(oghidulieu_dautien).Row Then
                r = sheet.Range(oghidulieu_dautien).Row
            Else
                r = r + 1
            End If
            Set cell_ = sheet.Range("A" & r)
            Set cell_ = cell_.Resize(sheet.Range(sRange).Rows.Count, sheet.Range(sRange).Columns.Count)
            sLink = "'" & sFolder & "\[" & sFileName & "]" & sShName & "'!" & sRange & ""
            sLink = "=IF(" & sLink & "<>""""," & sLink & ","""")"
            DataLink cell_, sLink, sFileName
        End If
        Set start_cell = start_cell.Offset(1)
    Loop
    
    Application.ScreenUpdating = True
    sheet.Activate
    If Len(sFile) > 0 Then
        sFile = "File link OK:" & vbNewLine & sFile
    Else
        sFile = "Không tìm thâ'y file link."
    End If
    MsgBox "Kêt thúc " & vbNewLine & sFile, vbOKOnly + vbInformation, "Cap nhat OK"

Loi_roi:
    If Err.Number <> 0 Then
        Application.ScreenUpdating = True
        MsgBox "Vui long lien he GPE!", vbCritical + vbOKOnly, "co loi xay ra:"
    End If
    
End Sub
 
Upvote 0
11.jpeg
Mình chạy nó báo lỗi thế này! bạn sửa giúp mình với.
 
Upvote 0
vonguyen3745 đã viết:
View attachment 262703
Mình chạy nó báo lỗi thế này
Nhấp chuột vào đây để mở rộng...
Bạn thiếu đoạn này ở phía trên, code OT gửi lại bài trên chỉ có Sub RunMe thôi:
Mã: 
Option Explicit

Dim sFile  As String
Sub DataLink(ByRef cell_ As Range, ByVal sLink As String, ByVal sFileName As String)
    On Error GoTo Err_
    cell_.FormulaArray = sLink: cell_.Value = cell_.Value
    If Len(sFile) = 0 Then sFile = sFileName Else sFile = sFile & vbNewLine & sFileName
Err_:
End Sub

Toàn bộ code đầy đủ, bạn copy lại tất cả nhé:
Mã: 
Option Explicit

Dim sFile  As String

Sub DataLink(ByRef cell_ As Range, ByVal sLink As String, ByVal sFileName As String)
    On Error GoTo Err_
    cell_.FormulaArray = sLink
    cell_.Value = cell_.Value
    If Len(sFile) = 0 Then sFile = sFileName Else sFile = sFile & vbNewLine & sFileName
Err_:
End Sub

Sub RunMe()

    On Error GoTo Loi_roi:

    Application.ScreenUpdating = False
    Dim sheet As Worksheet, start_cell As Range, cell_ As Range, str As String, tmp, r As Long
    Dim sFolder As String, sFileName As String, sShName As String, sRange As String, sLink As String
    
    Const tenFile_batdau As String = "A2"
    Const oGhidulieu_dautien As String = "A4"
    Const shGhiDuLieu As String = "Sheet2"
    sFile = Empty
    
    Set sheet = ThisWorkbook.Worksheets(shGhiDuLieu)
    sheet.Cells.ClearContents
    Set start_cell = Sheet1.Range(tenFile_batdau)
    
    Do Until start_cell.Value = ""
        str = start_cell.Value
        tmp = Split(str, "\")
        sFileName = tmp(UBound(tmp))
        sFolder = Mid(str, 1, Len(str) - Len(sFileName) - 1)
        If Len(Dir(sFolder & "\" & sFileName)) > 0 Then
            sShName = start_cell.Offset(, 1).Value
            sRange = start_cell.Offset(, 2).Value
            r = sheet.Range("A" & Rows.Count).End(xlUp).Row
            If r < sheet.Range(oGhidulieu_dautien).Row Then
                r = sheet.Range(oGhidulieu_dautien).Row
            Else
                r = r + 1
            End If
            Set cell_ = sheet.Range("A" & r)
            Set cell_ = cell_.Resize(sheet.Range(sRange).Rows.Count, sheet.Range(sRange).Columns.Count)
            sLink = "'" & sFolder & "\[" & sFileName & "]" & sShName & "'!" & sRange & ""
            sLink = "=IF(" & sLink & "<>""""," & sLink & ","""")"
            DataLink cell_, sLink, sFileName
        End If
        Set start_cell = start_cell.Offset(1)
    Loop
    
    Application.ScreenUpdating = True
    sheet.Activate
    If Len(sFile) > 0 Then
        sFile = "File link OK:" & vbNewLine & sFile
    Else
        sFile = "Không tìm thâ'y file link."
    End If
    MsgBox "Kêt thúc " & vbNewLine & sFile, vbOKOnly + vbInformation, "Cap nhat OK"

Loi_roi:
    If Err.Number <> 0 Then
        Application.ScreenUpdating = True
        MsgBox "Vui long lien he GPE!", vbCritical + vbOKOnly, "co loi xay ra:"
    End If
    
End Sub
 
Upvote 0
1.jpeg
2.jpeg
Mình chạy code trên file có đường dẫn thế này nó báo không tìm thấy link, đường dẫn dài quá có ảnh hưởng gì không bạn
 
Upvote 0
Upvote 0
Các file đều có cấu trúc kiểu thế này:
D:\TIEU_HOC\SynologyDrive\c1_anha\NAMHOC_2021-2022\1.TCCB\BIEU_MAU_EXCEL\DOINGU_TH_THANG7.xlsx
 
Upvote 0
vonguyen3745 đã viết:
Các file đều có cấu trúc kiểu thế này:
D:\TIEU_HOC\SynologyDrive\c1_anha\NAMHOC_2021-2022\1.TCCB\BIEU_MAU_EXCEL\DOINGU_TH_THANG7.xlsx
Nhấp chuột vào đây để mở rộng...
Chào Bạn, qua tìm hiểu với khả năng hiểu của OT thì nguyên nhân do xử lý đoạn này:
1626708674000.png

Vì vậy mà công thức dài quá gấp 2 lần so với ban đầu, OT có tham khảo ở đây thấy họ có thông tin:
1626708792515.png

OT không hiểu tiếng Tây lắm, đoán có thể do đường dẫn dài (quá 255 ký tự) đã đề cập ở bài 18,do vậy với đường dẫn dài thì cách của OT không khả thi, Bạn sử dụng code ở bài 2 nhé.
 
Upvote 0
Ở Bài 2 mình không biết chỗ chỉnh để nó bắt đầu dán dữ liệu ở dòng A4, bạn biết chỉnh giúp mình với.
 
Upvote 0
vonguyen3745 đã viết:
Ở Bài 2 mình không biết chỗ chỉnh để nó bắt đầu dán dữ liệu ở dòng A4, bạn biết chỉnh giúp mình với.
Nhấp chuột vào đây để mở rộng...
Code của bài 2 là sẽ dán dữ liệu nối đuôi nhau. Nếu bạn muốn gán dữ liệu ở dòng 4 thì dòng tiêu đề phải là dòng số 3 nhé. Lưu ý là trước khi chạy code phải xóa hết dữ liệu cũ, vì code sẽ dán nối đuôi so với dữ liệu đang có
 
Upvote 0
Quang_Hải đã viết:
Code của bài 2 là sẽ dán dữ liệu nối đuôi nhau. Nếu bạn muốn gán dữ liệu ở dòng 4 thì dòng tiêu đề phải là dòng số 3 nhé. Lưu ý là trước khi chạy code phải xóa hết dữ liệu cũ, vì code sẽ dán nối đuôi so với dữ liệu đang có
Nhấp chuột vào đây để mở rộng...
Chào anh Quang Hải, em thấy bài này dùng "FileSystemObject" để kiểm tra sự phù hợp của file có tồn tại hay không là khả thi nhất Anh nhỉ?
 
Upvote 0
Hoàng Nhật Phương đã viết:
Chào anh Quang Hải, em thấy bài này dùng "FileSystemObject" để kiểm tra sự phù hợp của file có tồn tại hay không là khả thi nhất Anh nhỉ?
Nhấp chuột vào đây để mở rộng...
Mấy cái này thuộc dạng cơ bản. Chẳng qua đang chán vì dịch covid nên chả buồn viết code. Đang bận cuốc đất trồng rau. Bài này trong khả năng của bạn mà.
 
Upvote 0
Quang_Hải đã viết:
Mấy cái này thuộc dạng cơ bản. Chẳng qua đang chán vì dịch covid nên chả buồn viết code. Đang bận cuốc đất trồng rau. Bài này trong khả năng của bạn mà.
Nhấp chuột vào đây để mở rộng...
Hic Anh còn có đất để cuốc :p, chỗ em hết rồi chỉ có mấy mét vuông để ăn nằm thôi Anh hiện tại đi làm về đến nhà là nằm và thở thôi anh ạ,chán hơn con gián.
 
Upvote 0
Quang_Hải đã viết:
Mấy cái này thuộc dạng cơ bản. Chẳng qua đang chán vì dịch covid nên chả buồn viết code. Đang bận cuốc đất trồng rau. Bài này trong khả năng của bạn mà.
Nhấp chuột vào đây để mở rộng...
Thế em với bác có thể đổi chỗ cho nhau được mà, bác viết code để em cuốc đất cho, em bên chân tay nên việc cuốc đất là việc nhỏ thôi.
 
Upvote 0
vonguyen3745 đã viết:
- Ý em là ở sheet đích, nếu có sẵn dữ liệu rồi thì code nó không copy đè lên dữ liệu ở đó.
- Em muốn chỉnh ô đầu tiên dán dữ liệu thì chỉnh thế nào bác, nó mặc định là ô A2, nhiều khi phần tiêu đề nó có 3-4 dòng thì lại không chạy được
Nhấp chuột vào đây để mở rộng...
- Code luôn chép đè lên dữ liệu cũ tại sheet đích. Do đó, muốn khỏi lộn xộn dữ liệu mới và cũ còn sót lại thì phải xóa hết dữ liệu cũ đi rồi chép dữ liệu mới.
=> Thêm dòng này vào đầu code để xóa dữ liệu cũ:
Sheet2.Range("A4:Z" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row).ClearContents
- Để chỉnh dòng đầu tiên dán dữ liệu thì thay dòng:
fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
bằng:
If i = 1 Then
fRow = 4
Else
fRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
End If
(fRow = 4 là dòng đầu, muốn sửa thì sửa con số này và sửa luôn Sheet2.Range("A4:Z" bên trên)
 
Upvote 0
thanks, sao em cứ đổi tên Sheet2 thành sheets khác nó lại không chạy nhỉ, em đã đổi tên cả trên excel và code mà nó toàn báo lỗi.
22.jpeg
4444.jpeg
 
Lần chỉnh sửa cuối:
Upvote 0
vonguyen3745 đã viết:
thanks, sao em cứ đổi tên Sheet2 thành sheets khác nó lại không chạy nhỉ, em đã đổi tên cả trên excel và code mà nó toàn báo lỗi.
View attachment 262771
View attachment 262773
Nhấp chuột vào đây để mở rộng...
Chỉnh tí
Mã: 
Sub ABC()
  Dim sArr(), cn As Object, i&, fRow&
  With Sheets("Sheet1")
    sArr = .Range("A2", .Range("C" & Rows.Count).End(xlUp)).Value
  End With
 
  Set cn = CreateObject("ADODB.Connection")
  On Error Resume Next
  With Sheets("DanhSach")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 3 Then .Range("B4:Z" & i).ClearContents 'Xoa ket qua cu
    For i = 1 To UBound(sArr)
      fRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
      If fRow < 4 Then fRow = 4
      cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sArr(i, 1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
      .Range("B" & fRow).CopyFromRecordset cn.Execute("select * from [" & sArr(i, 2) & "$" & sArr(i, 3) & "] where f1 is not null")
      cn.Close
    Next i
  End With
  Set cn = Nothing
End Sub
 
Upvote 0
Hoàng Nhật Phương đã viết:
Một cách làm khác, bạn tham khảo thêm:

Mã: 
Option Explicit

Dim sFile  As String
Sub DataLink(ByRef cell_ As Range, ByVal sLink As String, ByVal sFileName As String)
    On Error GoTo Err_
    cell_.FormulaArray = sLink: cell_.Value = cell_.Value
    If Len(sFile) = 0 Then sFile = sFileName Else sFile = sFile & vbNewLine & sFileName
Err_:
End Sub

Sub RunMe()

    Dim sheet As Worksheet, start_cell As Range, cell_ As Range, str As String, tmp
    Dim sFolder As String, sFileName As String, sShName As String, sRange As String
    Dim sLink As String
  
    Application.ScreenUpdating = False
    Set sheet = Sheet2: sheet.Cells.ClearContents
    Set start_cell = Sheet1.Range("A2")
    sFile = Empty
    Do Until start_cell.Value = ""
        str = start_cell.Value
        tmp = Split(str, "\")
        sFileName = tmp(UBound(tmp))
        sFolder = Mid(str, 1, Len(str) - Len(sFileName) - 1)
        If Len(Dir(sFolder & "\" & sFileName)) > 0 Then
            sShName = start_cell.Offset(, 1).Value
            sRange = start_cell.Offset(, 2).Value
            Set cell_ = sheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
            Set cell_ = cell_.Resize(sheet.Range(sRange).Rows.Count, sheet.Range(sRange).Columns.Count)
            sLink = "='" & sFolder & "\[" & sFileName & "]" & sShName & "'!" & sRange & ""
            DataLink cell_, sLink, sFileName
        End If
        Set start_cell = start_cell.Offset(1)
    Loop
  
    Application.ScreenUpdating = True
    sheet.Activate
  
    If Len(sFile) > 0 Then
        sFile = "File link OK:" & vbNewLine & sFile
    End If
  
    MsgBox "Kêt thúc " & vbNewLine & sFile, vbOKOnly + vbInformation
  
End Sub
Nhấp chuột vào đây để mở rộng...

Nhờ mọi người viết thêm giúp tạo thêm 02 cột: tên file, tên sheet với code bài này. Xin cảm ơn!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

N
  • Question Question
Tạo file lưu trữ dự liệu tự động (4 người xem)
Trả lời
8
Đọc
162
le_vis
L
M
  • Question Question
[Hỏi cách tạo VBA] - Xin các cao nhân chỉ giúp cách tạo VBA cho công việc thuận tiện hơn (1 người xem)
Trả lời
2
Đọc
37
manhcuonghg
M
S
cần xử lý dữ liệu trùng nhau bằng VBA (1 người xem)
    • Cười
Trả lời
6
Đọc
134
sonminhtran
S
N
Tạo file lưu trữ dữ liệu tự động trên excel. (1 người xem)
Trả lời
10
Đọc
152
nguyenle01
N
D
lọc các ô trong một cột chứa một nhóm dữ liệu? mong các cao thủ giải đáp giúp mình
Trả lời
3
Đọc
44
Gà Con yêu VBA
Gà Con yêu VBA
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (1 người xem)
Trả lời
7
Đọc
315
Gà Con yêu VBA
Gà Con yêu VBA
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ) (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
521
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian (1 người xem)
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
3
Đọc
140
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ (1 người xem)
Trả lời
4
Đọc
105
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
85
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
83
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt (2 người xem)
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
621
Quang_Hải
Quang_Hải
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

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

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom