Nhờ giúp: Code lấy địa chỉ file và code xuất nhiều file

Liên hệ QC

TN_Nguyen

Thành viên mới
Tham gia
15/4/22
Bài viết
12
Được thích
0
Kính chào mọi người!

Nhờ mọi người hỗ trợ giúp mình code cho 2 vấn đề sau ah:

Vấn đề 1: Code lấy thêm địa chỉ file
Trong File xử lý sheet(File-Gop) mình có 1 code (Sub ABC) dùng để lấy dữ liệu từ nhiều file chứa trong cùng folder, hiện tại code này chưa thể lấy được địa chỉ của file, nên nhờ mọi người giúp mình đoạn code có thế lấy địa chỉ file để điền vào cột A như trong file đính kèm.

Vấn đề 2: Code để tách và xuất nhiều file excel cùng lúc
Trong File xử lý sheet(Kết quả xử lý yêu cầu) yêu cầu xuất tất cả dữ liệu đã xử lý thành từng file riêng biệt (trong ví dụ có 3 vùng dữ liệu cần xuất file). Hiện tại khi dùng Macro mình chỉ có thể xuất được 1 file.

Rất mong mọi người giúp mình 2 vấn đề trên.
Xin cảm ơn mọi người!
 

File đính kèm

  • Công việc 1.rar
    166.2 KB · Đọc: 15
Kính chào mọi người!

Nhờ mọi người hỗ trợ giúp mình code cho 2 vấn đề sau ah:

Vấn đề 1: Code lấy thêm địa chỉ file
Trong File xử lý sheet(File-Gop) mình có 1 code (Sub ABC) dùng để lấy dữ liệu từ nhiều file chứa trong cùng folder, hiện tại code này chưa thể lấy được địa chỉ của file, nên nhờ mọi người giúp mình đoạn code có thế lấy địa chỉ file để điền vào cột A như trong file đính kèm.

Vấn đề 2: Code để tách và xuất nhiều file excel cùng lúc
Trong File xử lý sheet(Kết quả xử lý yêu cầu) yêu cầu xuất tất cả dữ liệu đã xử lý thành từng file riêng biệt (trong ví dụ có 3 vùng dữ liệu cần xuất file). Hiện tại khi dùng Macro mình chỉ có thể xuất được 1 file.

Rất mong mọi người giúp mình 2 vấn đề trên.
Xin cảm ơn mọi người!
Nói rõ là bạn muốn làm gì ở vấn đề 1.Diễn giải cụ thể ra lấy theo diều kiện nào các thứ.
 
Upvote 0
Nói rõ là bạn muốn làm gì ở vấn đề 1.Diễn giải cụ thể ra lấy theo diều kiện nào các thứ.
Ví dụ file đầu tiên 121-104-15.xlsx trong folder “File dữ liệu nguồn” có địa chỉ C:\Users\DELL\Downloads\Công việc 1\File dữ liệu nguồn\121-104-15.xlsx, mình cần lấy địa chỉ này điền vào các ô từ A5->A53 của sheet(File-Gop), tương tự địa chỉ của file 121-104-20.xlsx C:\Users\DELL\Downloads\Công việc 1\File dữ liệu nguồn\121-104-20.xlsx được điền vào ô từ A54->A82, file 121-104-30.xlsx cũng tương tự như trên.

Mục đích của việc này là mình muốn xác định được đâu là dữ liệu của từng file đơn (121-104-15.xlsx, 121-104-20.xlsx, 121-104-30.xlsx) khi chúng được gộp chung lại với nhau.
 
Upvote 0
Kính chào mọi người!

Nhờ mọi người hỗ trợ giúp mình code cho 2 vấn đề sau ah:

Vấn đề 1: Code lấy thêm địa chỉ file
Trong File xử lý sheet(File-Gop) mình có 1 code (Sub ABC) dùng để lấy dữ liệu từ nhiều file chứa trong cùng folder, hiện tại code này chưa thể lấy được địa chỉ của file, nên nhờ mọi người giúp mình đoạn code có thế lấy địa chỉ file để điền vào cột A như trong file đính kèm.

Vấn đề 2: Code để tách và xuất nhiều file excel cùng lúc
Trong File xử lý sheet(Kết quả xử lý yêu cầu) yêu cầu xuất tất cả dữ liệu đã xử lý thành từng file riêng biệt (trong ví dụ có 3 vùng dữ liệu cần xuất file). Hiện tại khi dùng Macro mình chỉ có thể xuất được 1 file.

Rất mong mọi người giúp mình 2 vấn đề trên.
Xin cảm ơn mọi người!
Trong khi chờ các giải pháp khác. có thể thử để có kết quả như ý:
Lưu ý : không nên meger các ô.
Vấn đề xác định tên Sh mới là duy nhất, bạn tự làm
 

File đính kèm

  • Công việc 1.zip
    166.2 KB · Đọc: 10
Upvote 0
Cảm ơn HUONGHCKT đã hỗ trợ, không biết sao mình thấy nó vẫn chưa hoạt động như yêu cầu, hiện tại vấn đề 1: code vẫn chưa lấy địa chỉ điền vào cột A. Còn vấn đề 2: chỉ mới xuất được 1 file như trước, nó vẫn chưa xuất ra được 3 file như mong muốn.
 
Upvote 0
Cảm ơn HUONGHCKT đã hỗ trợ, không biết sao mình thấy nó vẫn chưa hoạt động như yêu cầu, hiện tại vấn đề 1: code vẫn chưa lấy địa chỉ điền vào cột A. Còn vấn đề 2: chỉ mới xuất được 1 file như trước, nó vẫn chưa xuất ra được 3 file như mong muốn.
Làm xong test lại và gửi trả bài không hiểu sao lại gửi đúng Tệp cũ. và không Save lại. giờ mở ra mất tiêu hết code, lại phải làm lại. Thành thật xin lỗi bạn.
Xem file.
 

File đính kèm

  • File xử lý.xlsm
    56.1 KB · Đọc: 14
Upvote 0
Rât cảm ơn HUONGHCKT!
Code đã giải quyết rất tốt yêu cầu thứ nhất của mình.
Còn vấn đề 2 mình có ý này, hy vọng bạn xem qua ý tưởng này giúp mình,
Ở sh đầu tiên mình sẽ chèn thêm 1 cột, cột này có 2 tác dụng (tạo ra tên cho file excel sau này và tạo ra một ô địa chỉ để code bên dưới có thể bắt được tên đó). Khi đó, vấn đề lúc này sẽ là xuất các sh vừa tạo thành từng file excel riêng biệt với tên mỗi file excel sẽ được lấy từ ô AE5 cố định trên mỗi sh vừa được tạo đó.
ChDir "C:\Users\DELL\Desktop"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\DELL\Desktop\" & Range("AE6").Value2 & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Rất mong HUONGHCKT và mọi người xem qua ý trên và hỗ trợ giúp mình!
 

File đính kèm

  • File xử lý - VĐ2.xlsm
    100.4 KB · Đọc: 5
Lần chỉnh sửa cuối:
Upvote 0
Rât cảm ơn HUONGHCKT!
Code đã giải quyết rất tốt yêu cầu thứ nhất của mình.
Còn vấn đề 2 mình có ý này, hy vọng bạn xem qua ý tưởng này giúp mình,
Ở sh đầu tiên mình sẽ chèn thêm 1 cột, cột này có 2 tác dụng (tạo ra tên cho file excel sau này và tạo ra một ô địa chỉ để code bên dưới có thể bắt được tên đó). Khi đó, vấn đề lúc này sẽ là xuất các sh vừa tạo thành từng file excel riêng biệt với tên mỗi file excel sẽ được lấy từ ô AE5 cố định trên mỗi sh vừa được tạo đó.
ChDir "C:\Users\DELL\Desktop"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\DELL\Desktop\" & Range("AE6").Value2 & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Rất mong HUONGHCKT và mọi người xem qua ý trên và hỗ trợ giúp mình!
Xem file. Các vấn đề về tiêu đề, định dạng bạn tự làm.
 

File đính kèm

  • File xử lý.xlsm
    47.7 KB · Đọc: 15
Upvote 0
Xem file. Các vấn đề về tiêu đề, định dạng bạn tự làm.

Tôi thấy bạn lưu chết (hard code) các đường dẫn vào code VBA là không thuận tiện cho việc sửa đổi rồi, hơn nữa là có ký tự tiếng Việt code dấu nữa. Đường dẫn kiểu này không linh động thay đổi được sau này, muốn thay đổi lại phải vô code mà xử lý.
Tôi thấy qui ước đặt tên và đường dẫn lưu file theo bài của chủ thớt cũng thống nhất, không tùy biến nhiều, cách tôi làm là:
- Mở hộp thoại người dùng tự chọn đường dẫn lưu file.
- Tên file thì lấy từ cột [Số lô]
--> khỏi thêm cột phụ để xử lý cho vụ folder và tên File.
 
Upvote 0
Xem file. Các vấn đề về tiêu đề, định dạng bạn tự làm.
Cách xử lý mới của HUONGHCKT đã tạo ra được các file excel riêng biệt, nhưng có 4 chỗ mình còn thắc mắc:
Thứ nhất: kết quả trong mỗi file đều giống nhau (cùng là nội dung của những dòng đầu tiên).
Thứ 2: trong yêu cầu vd kết quả chỉ cần tạo ra 3 file, nhưng code lại tạo ra được 4 file, vậy sau này nếu yêu cầu công việc cần tạo ra 5, 6 file thì code có tạo tạo được không hay chỉ mặc định 4 file cố định.
H1.PNG
Thứ 3: dòng đầu tiên của file mới đã bị đôn lên 1 dòng so với sh File-Gop (từ dòng 5 lên dòng 4).
Thứ 4: có thể giữ nguyên tiêu đề nằm ở dòng 3, 4 trong sh File-Gop khi xuất thành các file riêng được không, do kiến thức của mình hiện tại thực sự không làm được tiêu đề cho các file excel riêng lẽ (trừ khi mình làm thủ công cho từng file).
H2.PNG
Sorry mình thắc mắc hơi nhiều, mong HUONGHCKT và mọi người thông cảm!
 
Upvote 0
Tôi thấy bạn lưu chết (hard code) các đường dẫn vào code VBA là không thuận tiện cho việc sửa đổi rồi, hơn nữa là có ký tự tiếng Việt code dấu nữa. Đường dẫn kiểu này không linh động thay đổi được sau này, muốn thay đổi lại phải vô code mà xử lý.
Tôi thấy qui ước đặt tên và đường dẫn lưu file theo bài của chủ thớt cũng thống nhất, không tùy biến nhiều, cách tôi làm là:
- Mở hộp thoại người dùng tự chọn đường dẫn lưu file.
- Tên file thì lấy từ cột [Số lô]
--> khỏi thêm cột phụ để xử lý cho vụ folder và tên File.
Ý kiến giải quết của ongke0711 cũng hay nè, còn trường hợp xử lý folder và tên file, vẫn cần 1 cột lấy địa chỉ của file do trong trường hợp này vô tình cột [số lô] trùng với tên file (có thể về sau sẽ có quy ước đặt tên khác), còn tên file sẽ có một mã mở rộng phía sau [Số lô] nên cũng cần thêm một ô để hàm xử lý lại tên file trước khi xuất riêng.
 
Upvote 0
Tôi thấy bạn lưu chết (hard code) các đường dẫn vào code VBA là không thuận tiện cho việc sửa đổi rồi, hơn nữa là có ký tự tiếng Việt code dấu nữa. Đường dẫn kiểu này không linh động thay đổi được sau này, muốn thay đổi lại phải vô code mà xử lý.
Tôi thấy qui ước đặt tên và đường dẫn lưu file theo bài của chủ thớt cũng thống nhất, không tùy biến nhiều, cách tôi làm là:
- Mở hộp thoại người dùng tự chọn đường dẫn lưu file.
- Tên file thì lấy từ cột [Số lô]
--> khỏi thêm cột phụ để xử lý cho vụ folder và tên File.
Thời buổi bi giờ nó không quan trọng lắm nữa.
Cách để giải quyết 99% các trường hợp hard code là chỉ việc viết một số hàm trả về giá trị magic numbers/values ấy. Về sau muốn sửa đổi gì thì sửa cái hàm. Rất hiếm (1%) trường hợp ngoại lệ mà cách này không thể thực hiện được.

Function TenDuongDan()
TenDuongDan = "G:\Tò te tí te tò\"
End Function

Bên trong code chính chỉ cần gọi:
caiTenFile= TenDuongDan & "caiTen.xlsx"

Về sau muốn thay đổi cứ việc vào TenDuongDan mà đổi. Ngay cả muốn hộp thoại nhập vào đó lại càng tốt hơn. Đỡ rườm rà code chính, và bảo quản dễ hơn bên trong code chính nhiều. Copy vào project khác lại càng thuận tiện.
 
Upvote 0
Cách xử lý mới của HUONGHCKT đã tạo ra được các file excel riêng biệt, nhưng có 4 chỗ mình còn thắc mắc:
Thứ nhất: kết quả trong mỗi file đều giống nhau (cùng là nội dung của những dòng đầu tiên).
Thứ 2: trong yêu cầu vd kết quả chỉ cần tạo ra 3 file, nhưng code lại tạo ra được 4 file, vậy sau này nếu yêu cầu công việc cần tạo ra 5, 6 file thì code có tạo tạo được không hay chỉ mặc định 4 file cố định.
View attachment 278988
Thứ 3: dòng đầu tiên của file mới đã bị đôn lên 1 dòng so với sh File-Gop (từ dòng 5 lên dòng 4).
Thứ 4: có thể giữ nguyên tiêu đề nằm ở dòng 3, 4 trong sh File-Gop khi xuất thành các file riêng được không, do kiến thức của mình hiện tại thực sự không làm được tiêu đề cho các file excel riêng lẽ (trừ khi mình làm thủ công cho từng file).
View attachment 278989
Sorry mình thắc mắc hơi nhiều, mong HUONGHCKT và mọi người thông cảm!
Bạn thay code trong modul 3 bằng code này: (có cả dòng tiêu đề-Không Meger cell)
Mã:
Option Explicit

Sub PhanTachThanhNhieuFile()

Dim Ws As Worksheet, NWs As Worksheet
Dim i&, j&, t&, k&, Lr&, Z&
Dim Arr(), ArrN(), ArrTde(), Res(), S
Dim Odau As Range
Dim MyPath      As String, SoLo As String, fso         As Object

Application.ScreenUpdating = False

'Loc duy nhat
Set Ws = ThisWorkbook.Sheets("File-Gop")
Lr = Ws.Range("A" & Rows.Count).End(xlUp).Row
If Lr<5 or Len(Ws.[AG1]) = 0 Then Exit Sub   ' Kiêm tra tính hợp lý của dữ liệu
Ws.Range(Ws.Cells(5, 1), Ws.Cells(Lr, 1)).Copy
Ws.Cells(1, 53).PasteSpecial xlPasteValues
Ws.Cells(1, 53).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
ArrN = Ws.Cells(1, 53).CurrentRegion.Value
ArrTde = Ws.Range("B3:AD4").Value
Arr = Ws.Range("A5:AD" & Lr).Value
ReDim Res(1 To UBound(Arr), 1 To UBound(Arr, 2) - 1)
On Error Resume Next
ReDim Tieude(1 To 2, 1 To UBound(Arr, 2) - 1)
 For j = 1 To UBound(ArrTde)
        Z = Z + 1
        For k = 1 To UBound(Arr, 2)
               Tieude(Z, k) = ArrTde(j, k)
        Next k
Next j
For i = 1 To UBound(ArrN)
t = 0
     For j = 1 To UBound(Arr)
        If Arr(j, 1) = ArrN(i, 1) Then
            t = t + 1
            For k = 2 To UBound(Arr, 2)
                Res(t, k - 1) = Arr(j, k)
            Next k
        End If
    Next j
   ' S = Split(ArrN(i, 1), "\")
   SoLo = Res(1, 6)
    Application.ThisWorkbook.Save
      '  MyPath = ThisWorkbook.Path & "\File KQ sau xu ly"
        MyPath = ThisWorkbook.Path & "\" & Ws.[AG1] 'File KQ sau xu ly"

    If Right(MyPath, 1) <> "\" Then
    '    MyPath = Left(MyPath, Len(MyPath) - 1)
        MyPath = MyPath & "\"
    End If
        Set fso = CreateObject("scripting.filesystemobject")
    If fso.FolderExists(MyPath) = False Then
        Application.ScreenUpdating = False
         fso.CreateFolder MyPath
    Workbooks.Add
        Sheets("Sheet1").Select
        Set NWs = ActiveSheet
        NWs.Range("A3").Resize(Z, UBound(ArrTde, 2) - 1) = Tieude
        NWs.Range("A5").Resize(t, UBound(Arr, 2) - 1) = Res
        NWs.Name = SoLo
    NWs.Cells.EntireColumn.AutoFit
    ActiveWorkbook.SaveAs MyPath & SoLo & ".xlsx"
    ActiveWorkbook.Close
Else
    Workbooks.Add
        Sheets("Sheet1").Select
        Set NWs = ActiveSheet
        NWs.Range("A3").Resize(Z, UBound(ArrTde, 2) - 1) = Tieude
        NWs.Range("A5").Resize(t, UBound(Arr, 2) - 1) = Res
        NWs.Name = SoLo
    NWs.Cells.EntireColumn.AutoFit
    ActiveWorkbook.SaveAs MyPath & SoLo & ".xlsx"
    ActiveWorkbook.Close
End If
Ws.Select
Next i
Set fso = Nothing
Ws.Columns(53).Delete
Application.ScreenUpdating = True

MsgBox " Đa hoàn thành"
End Sub
Bạn phải nhập tên Folder muốn lưu vào Ô AG1/Sh File-Gop thì code mới chạy.
Lưu ý trong trường hợp Bạn muốn lưu vào 1 folder mới có tên =AG1, mà folder này chưa có thì code cũng tạo luôn 1 folder có tên là giá trị của ô AG1 và lưu vào đó. Sau này bạn muốn có tùy chọn khác chỉ việc thay đổi ở ô AG1/Sh File_Gop và chạy code là xong.
 
Upvote 0
Bạn thay code trong modul 3 bằng code này: (có cả dòng tiêu đề-Không Meger cell)
Mã:
Option Explicit

Sub PhanTachThanhNhieuFile()

Dim Ws As Worksheet, NWs As Worksheet
Dim i&, j&, t&, k&, Lr&, Z&
Dim Arr(), ArrN(), ArrTde(), Res(), S
Dim Odau As Range
Dim MyPath      As String, SoLo As String, fso         As Object

Application.ScreenUpdating = False

'Loc duy nhat
Set Ws = ThisWorkbook.Sheets("File-Gop")
Lr = Ws.Range("A" & Rows.Count).End(xlUp).Row
If Lr<5 or Len(Ws.[AG1]) = 0 Then Exit Sub   ' Kiêm tra tính hợp lý của dữ liệu
Ws.Range(Ws.Cells(5, 1), Ws.Cells(Lr, 1)).Copy
Ws.Cells(1, 53).PasteSpecial xlPasteValues
Ws.Cells(1, 53).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
ArrN = Ws.Cells(1, 53).CurrentRegion.Value
ArrTde = Ws.Range("B3:AD4").Value
Arr = Ws.Range("A5:AD" & Lr).Value
ReDim Res(1 To UBound(Arr), 1 To UBound(Arr, 2) - 1)
On Error Resume Next
ReDim Tieude(1 To 2, 1 To UBound(Arr, 2) - 1)
 For j = 1 To UBound(ArrTde)
        Z = Z + 1
        For k = 1 To UBound(Arr, 2)
               Tieude(Z, k) = ArrTde(j, k)
        Next k
Next j
For i = 1 To UBound(ArrN)
t = 0
     For j = 1 To UBound(Arr)
        If Arr(j, 1) = ArrN(i, 1) Then
            t = t + 1
            For k = 2 To UBound(Arr, 2)
                Res(t, k - 1) = Arr(j, k)
            Next k
        End If
    Next j
   ' S = Split(ArrN(i, 1), "\")
   SoLo = Res(1, 6)
    Application.ThisWorkbook.Save
      '  MyPath = ThisWorkbook.Path & "\File KQ sau xu ly"
        MyPath = ThisWorkbook.Path & "\" & Ws.[AG1] 'File KQ sau xu ly"

    If Right(MyPath, 1) <> "\" Then
    '    MyPath = Left(MyPath, Len(MyPath) - 1)
        MyPath = MyPath & "\"
    End If
        Set fso = CreateObject("scripting.filesystemobject")
    If fso.FolderExists(MyPath) = False Then
        Application.ScreenUpdating = False
         fso.CreateFolder MyPath
    Workbooks.Add
        Sheets("Sheet1").Select
        Set NWs = ActiveSheet
        NWs.Range("A3").Resize(Z, UBound(ArrTde, 2) - 1) = Tieude
        NWs.Range("A5").Resize(t, UBound(Arr, 2) - 1) = Res
        NWs.Name = SoLo
    NWs.Cells.EntireColumn.AutoFit
    ActiveWorkbook.SaveAs MyPath & SoLo & ".xlsx"
    ActiveWorkbook.Close
Else
    Workbooks.Add
        Sheets("Sheet1").Select
        Set NWs = ActiveSheet
        NWs.Range("A3").Resize(Z, UBound(ArrTde, 2) - 1) = Tieude
        NWs.Range("A5").Resize(t, UBound(Arr, 2) - 1) = Res
        NWs.Name = SoLo
    NWs.Cells.EntireColumn.AutoFit
    ActiveWorkbook.SaveAs MyPath & SoLo & ".xlsx"
    ActiveWorkbook.Close
End If
Ws.Select
Next i
Set fso = Nothing
Ws.Columns(53).Delete
Application.ScreenUpdating = True

MsgBox " Đa hoàn thành"
End Sub
Bạn phải nhập tên Folder muốn lưu vào Ô AG1/Sh File-Gop thì code mới chạy.
Lưu ý trong trường hợp Bạn muốn lưu vào 1 folder mới có tên =AG1, mà folder này chưa có thì code cũng tạo luôn 1 folder có tên là giá trị của ô AG1 và lưu vào đó. Sau này bạn muốn có tùy chọn khác chỉ việc thay đổi ở ô AG1/Sh File_Gop và chạy code là xong.
Rất cảm ơn HUONGHCKT đã bỏ thời gian hỗ trợ :type: cho công việc của mình!
Cả 2 vấn đề của mình đã được giải quyết gần như hoàn hảo :thumbs:, mình sẽ tinh chỉnh một chút cho phần định dạng tiêu đề nữa là coi như hoàn thành.
Một lần nữa xin cảm ơn HUONGHCKT và mọi người trên diễn đàn Giaiphapexcel!
 
Upvote 0
Web KT

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

Back
Top Bottom