Code tạo thư mục (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)
T

toangiaphat

Thành viên hoạt động
Tham gia
6/5/09
Bài viết
136
Được thích
3
MÌnh nghe nói Excel có thể xuất folder được bạn nào biết chỉ mình nha. đang cần rất gấp.

Chuyện là vầy: mình có 2 cột gồm cột số và tên. mình muốn bấm nút lệnh trong bảng tính tự nó sẽ tạo các folder theo danh sách. Với cú pháp tao Folder : số_Tên.

nhờ cao thủ làm giúp!
Cám ơn diễn đàn
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
toangiaphat đã viết:
MÌnh nghe nói Excel có thể xuất folder được bạn nào biết chỉ mình nha. đang cần rất gấp.

Chuyện là vầy: mình có 2 cột gồm cột số và tên. mình muốn bấm nút lệnh trong bảng tính tự nó sẽ tạo các folder theo danh sách. Với cú pháp tao Folder : số_Tên.

nhờ cao thủ làm giúp!
Cám ơn diễn đàn
Nhấp chuột vào đây để mở rộng...

Tạo thư mục rồi đặt nó ở đâu? Đặt ở ổ C, D, E... hay nằm cùng với thư mục của file Excel?. Bạn chưa đề cập đến vấn đề này nha
 
Upvote 0
toangiaphat đã viết:
MÌnh nghe nói Excel có thể xuất folder được bạn nào biết chỉ mình nha. đang cần rất gấp.

Chuyện là vầy: mình có 2 cột gồm cột số và tên. mình muốn bấm nút lệnh trong bảng tính tự nó sẽ tạo các folder theo danh sách. Với cú pháp tao Folder : số_Tên.

nhờ cao thủ làm giúp!
Cám ơn diễn đàn
Nhấp chuột vào đây để mở rộng...
Tôi giả sử bạn tạo thư mục ROOT nằm cùng thư mục với file hiện hành, các thư mục con nằm trong thư mục ROOT này.

1. Trang bị một hàm để loại dấu tiếng Việt (Unicode):
[GPECODE=vb]Function LoaiDauUni(Text As String) As String
Const CodUni = " 225 224 7843 227 7841 259 7855 7857 7859 7861 7863 226 7845 7847 7849 7851 7853 273 233 232 7867 7869 7865 234 7871 7873 7875 7877 7879 237 236 7881 297 7883 243 242 7887 245 7885 244 7889 7891 7893 7895 7897 417 7899 7901 7903 7905 7907 250 249 7911 361 7909 432 7913 7915 7917 7919 7921 253 7923 7927 7929 7925 193 192 7842 195 7840 258 7854 7856 7858 7860 7862 194 7844 7846 7848 7850 7852 272 201 200 7866 7868 7864 202 7870 7872 7874 7876 7878 205 204 7880 296 7882 211 210 7886 213 7884 212 7888 7890 7892 7894 7896 416 7898 7900 7902 7904 7906 218 217 7910 360 7908 431 7912 7914 7916 7918 7920 221 7922 7926 7928 7924 "
Const Str0dau = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyyAAAAAAAAAAAAAAAAADEEEEEEEEEEEIIIIIOOOOOOOOOOOOOOOOOUUUUUUUUUUUYYYYY"
Dim MaDau As String, KyTu As String, CodKyTu As String, NewText As String, ViTri As Long, n As Long


Text = Text & " "
MaDau = " "
For n = 1 To Len(Text) - 1
KyTu = Mid(Text, n, 1)
CodKyTu = AscW(KyTu) & String(5 - Len(CStr(AscW(KyTu))), " ")
ViTri = InStr(1, CodUni, CodKyTu, 0) / 5
If ViTri > 0 Then
NewText = NewText & Mid(Str0dau, ViTri, 1)
Else
NewText = NewText & KyTu
End If
Next
LoaiDauUni = NewText
End Function[/GPECODE]
2. Sử dụng code sau để tạo thư mục:
[GPECODE=vb]Sub MakeFolder()
Dim sRoot As String, sPath As String, Rng As Range, FS
On Error Resume Next
sRoot = ThisWorkbook.Path & "\ROOT"
Set FS = CreateObject("Scripting.FileSystemObject")
If Not (FS.FolderExists(sRoot)) Then MkDir sRoot
For Each Rng In Sheets("RESULT").[A2:A100]
If IsEmpty(Rng) Then Exit Sub
sPath = sRoot & "\" & Rng & "_" & Replace(LoaiDauUni(Rng.Offset(, 1)), " ", "")
If Not (FS.FolderExists(sPath)) Then MkDir sPath
Next
End Sub[/GPECODE]
Để đổi đường dẫn cho thư mục "mẹ", bạn chỉ cần sửa câu lệnh sRoot = ThisWorkbook.Path & "\ROOT" là được.
 

File đính kèm

Upvote 0
nghiaphuc đã viết:
Tôi giả sử bạn tạo thư mục ROOT nằm cùng thư mục với file hiện hành, các thư mục con nằm trong thư mục ROOT này.

1. Trang bị một hàm để loại dấu tiếng Việt (Unicode):
Nhấp chuột vào đây để mở rộng...

Loại dấu tiếng Việt để làm gì vậy Phúc? Mình nghĩ thư mục Nghĩa Phúc và Nghĩa Phục sẽ là 2 thư mục khác nhau chứ đâu thể là một?
Mã: 
Sub MakeFolder()
    Dim sRoot As String, sPath As String, Rng As Range, FS
    On Error Resume Next
    sRoot = ThisWorkbook.Path & "\ROOT"
    Set FS = CreateObject("Scripting.FileSystemObject")
    If Not (FS.FolderExists(sRoot)) Then MkDir sRoot
    For Each Rng In Sheets("RESULT").[A2:A100]
        If IsEmpty(Rng) Then Exit Sub
        sPath = sRoot & "\" & Rng & "_" & Replace(LoaiDauUni(Rng.Offset(, 1)), " ", "")
        If Not (FS.FolderExists(sPath)) Then [COLOR=#ff0000]MkDir[/COLOR] sPath
    Next
End Sub
Đã dùng Scripting.FileSystemObject rồi, tự nhiên lại MkDir ---> Thừa và dở thấy.. ớn luôn
Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Đã dùng Scripting.FileSystemObject rồi, tự nhiên lại MkDir ---> Thừa và dở thấy.. ớn luôn
Ẹc... Ẹc...
Nhấp chuột vào đây để mở rộng...
Vậy thì phải sửa thế nào cho phù hợp anh? Em cũng chỉ "lượm nhặt", "chắp vá" trên diễn đàn thôi chứ có sáng tạo được ra nó đâu. Hic...
 
Upvote 0
nghiaphuc đã viết:
Vậy thì phải sửa thế nào cho phù hợp anh? Em cũng chỉ "lượm nhặt", "chắp vá" trên diễn đàn thôi chứ có sáng tạo được ra nó đâu. Hic...
Nhấp chuột vào đây để mở rộng...

Scripting.FileSystemObject là chuyên gia về xử lý file, folder. Nó hoàn hảo hơn rất nhiều so với các hàm VB cùng tính năng
Cú pháp tạo thư mục: FS.CreateFolder(Path)
 
Upvote 0
Tham gia 1 code cho vui, code này chưa có loại bỏ dấu tiếng việt.

PHP: 
Sub CreateFolder()
Dim Path As String, ThuMucCon(), I As Integer, Tmp
ThuMucCon = [A1:B100].Value
Path = ThisWorkbook.Path & "\ThuMucTong"
With CreateObject("Scripting.FileSystemObject")
    If Not (.FolderExists(Path)) Then .CreateFolder (Path)
    For I = 1 To UBound(ThuMucCon)
        Tmp = ThuMucCon(I, 1) & ThuMucCon(I, 2)
        If Not (.FolderExists(Path & "\" & Tmp)) Then
            .CreateFolder (Path & "\" & Tmp)
        End If
    Next
End With
End Sub
 
Upvote 0
Dạ đúng rồi Em yêu cầu bỏ dấu tiếng việt. Nếu được thì tạo folder chủ chứa file excel và các folder con luôn.
Cám ơn bạn. Ráng giúp mình nhé!
 
Upvote 0
Sao mình thêm cột vao thì ko còn tạo folder đươc nữa. Bạ chỉnh lại giùm mình tạo Folder Root trong Ổ D nha. Thanks
 

File đính kèm

Upvote 0
QUANGHAI giúp mình hoàn thành cái file này được ko? hỏi hoài mà ko ai có thể giúp mình cả. post nơi khác thì bị lock
 

File đính kèm

Upvote 0
toangiaphat đã viết:
QUANGHAI giúp mình hoàn thành cái file này được ko? hỏi hoài mà ko ai có thể giúp mình cả. post nơi khác thì bị lock
Nhấp chuột vào đây để mở rộng...
Sau này đừng gọi tên mình nữa vì bài này đối với mình thì khá khó, nhưng với mọi người trên GPE thì chắc không khó lắm.
Vì khó quá nên mò mẫm đến giờ mới viết xong code, không biết là có trúng hay không. Mình cho đường dẫn vào ổ D thư mục ROOT
 

File đính kèm

Upvote 0
Hai khiêm tốn qua. Vì mình ở Tây Ninh xa qua. Bạn ở đâu nếu có dịp mình xin phép mời bạn 1 chầu cafe để đáp lại sự hổ trợ này.
Cám ơn rất nhiều!
 
Upvote 0
QUANGHAI như vậy ok rồi! nhưng bỏ dấu cách trong folder giùm mình nha.
ví dụ: 1613973_TRAN VAN SINH sữa lại thành 1613973_TRANVANSINH.
cảm ơn!-=.,,
 
Upvote 0
toangiaphat đã viết:
QUANGHAI như vậy ok rồi! nhưng bỏ dấu cách trong folder giùm mình nha.
ví dụ: 1613973_TRAN VAN SINH sữa lại thành 1613973_TRANVANSINH.
cảm ơn!-=.,,
Nhấp chuột vào đây để mở rộng...
Mở module1 ra, thay code này vào
PHP: 
Sub CreateFolder()
Dim Path As String, ThuMucCon(), i As Integer, tmp
ThuMucCon = Range([E2], [K65536].End(3)).Value
Path = "D:\ROOT"
With CreateObject("Scripting.FileSystemObject")
    If Not (.FolderExists(Path)) Then .CreateFolder (Path)
    For i = 1 To UBound(ThuMucCon)
      If ThuMucCon(i, 7) <> "P" Then
        tmp = TV(ThuMucCon(i, 1) & "_" & ThuMucCon(i, 2))
        tmp = Replace(tmp, Space(1), "")
        If Not (.FolderExists(Path & "\" & tmp)) Then
            .CreateFolder (Path & "\" & tmp)
        End If
      End If
    Next
End With
End Sub
toangiaphat đã viết:
Hai khiêm tốn qua. Vì mình ở Tây Ninh xa qua. Bạn ở đâu nếu có dịp mình xin phép mời bạn 1 chầu cafe để đáp lại sự hổ trợ này.
Cám ơn rất nhiều!
Nhấp chuột vào đây để mở rộng...
Nếu có ý muốn mời cafe thì qua Bình Dương nha. Tây Ninh và Bình Dương chỉ cách có 100km
 
Upvote 0
Hải ơi! Hình như chạy không đúng rồi. Khi mình nhiều hơn thì nó không tạo đủ
 

File đính kèm

Upvote 0
toangiaphat đã viết:
Hải ơi! Hình như chạy không đúng rồi. Khi mình nhiều hơn thì nó không tạo đủ
Nhấp chuột vào đây để mở rộng...
Tại vì thay đổi cấu trúc file
PHP: 
Sub CreateFolder()
Dim Path As String, ThuMucCon(), i As Integer, tmp
ThuMucCon = Range([E2], [E65536].End(3)).Resize(, 7).Value
Path = "D:\ROOT"
With CreateObject("Scripting.FileSystemObject")
    If Not (.FolderExists(Path)) Then .CreateFolder (Path)
    For i = 1 To UBound(ThuMucCon)
      If ThuMucCon(i, 7) <> "P" Then
        tmp = TV(ThuMucCon(i, 1) & "_" & ThuMucCon(i, 2))
        tmp = Replace(tmp, Space(1), "")
        If Not (.FolderExists(Path & "\" & tmp)) Then
            .CreateFolder (Path & "\" & tmp)
        End If
      End If
    Next
End With
End Sub
 
Upvote 0
Bác Hải ơi! Sau thời gian sử dụng File của Bác giúp Em rất nhiều trong công việc. Cám ơn Bác.

Hôm nay, Em nhờ các Bác chỉnh giúp E 1 số chi tiết cuối cùng nhé.

Bác nào ghé qua, chỉnh giúp Em.

Cám ơn các Bác!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Định tải về thử sức mình, nhưng hình như quá sức mình. Bạn toangiaphat chờ cao thủ khác thôi. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
Upvote 0
toangiaphat đã viết:
Bác Hải ơi! Sau thời gian sử dụng File của Bác giúp Em rất nhiều trong công việc. Cám ơn Bác.

Hôm nay, Em nhờ các Bác chỉnh giúp E 1 số chi tiết cuối cùng nhé.

Bác nào ghé qua, chỉnh giúp Em.

Cám ơn các Bác!
Nhấp chuột vào đây để mở rộng...
Bài này không khó, nhưng giờ chưa có thời gian. Lúc nào có thời gian mình viết tiếp cho.
 
Upvote 0
toangiaphat đã viết:
Bác Hải ơi! Sau thời gian sử dụng File của Bác giúp Em rất nhiều trong công việc. Cám ơn Bác.

Hôm nay, Em nhờ các Bác chỉnh giúp E 1 số chi tiết cuối cùng nhé.

Bác nào ghé qua, chỉnh giúp Em.

Cám ơn các Bác!
Nhấp chuột vào đây để mở rộng...

Thay code này vào trong module1 trong file của bạn
PHP: 
Sub CreateFolder()
Dim path As String, SubFolder(), i, tmp, Strpath, j
SubFolder = Range([E2], [E65536].End(3)).Resize(, 6).Value
path = "D:\ROOT"
With CreateObject("Scripting.FileSystemObject")
    If Not (.FolderExists(path)) Then .CreateFolder (path)
    For i = 1 To UBound(SubFolder)
      If SubFolder(i, 5) & SubFolder(i, 6) <> Empty Then
        tmp = TV(SubFolder(i, 1) & "_" & SubFolder(i, 2))
        tmp = Replace(tmp, Space(1), "")
        Strpath = path & "\" & tmp
        If Not .FolderExists(Strpath) Then
            .CreateFolder (Strpath)
            For j = 5 To 6
               If SubFolder(i, j) <> "" Then
                  If Not .FolderExists(Strpath & "\" & SubFolder(i, j)) Then
                     .CreateFolder Strpath & "\" & SubFolder(i, j)
                  End If
               End If
            Next
        End If
      End If
    Next
End With
End Sub
 
Upvote 0
quanghai1969 đã viết:
thay code này vào trong module1 trong file của bạn
PHP: 
sub createfolder()
dim path as string, subfolder(), i, tmp, strpath, j
subfolder = range([e2], [e65536].end(3)).resize(, 6).value
path = "d:\root"
with createobject("scripting.filesystemobject")
    if not (.folderexists(path)) then .createfolder (path)
    for i = 1 to ubound(subfolder)
      if subfolder(i, 5) & subfolder(i, 6) <> empty then
        tmp = tv(subfolder(i, 1) & "_" & subfolder(i, 2))
        tmp = replace(tmp, space(1), "")
        strpath = path & "\" & tmp
        if not .folderexists(strpath) then
            .createfolder (strpath)
            for j = 5 to 6
               if subfolder(i, j) <> "" then
                  if not .folderexists(strpath & "\" & subfolder(i, j)) then
                     .createfolder strpath & "\" & subfolder(i, j)
                  end if
               end if
            next
        end if
      end if
    next
end with
end sub
Nhấp chuột vào đây để mở rộng...

bác hải ơi! ở cột j nếu là chữ "w" thì tạo, ngoài ra những chữ khác thì không tạo folder được không bác.?
 
Upvote 0
toangiaphat đã viết:
bác hải ơi! ở cột j nếu là chữ "w" thì tạo, ngoài ra những chữ khác thì không tạo folder được không bác.?
Nhấp chuột vào đây để mở rộng...
Được. Thêm tí nữa

PHP: 
           if not .folderexists(strpath & "\" & subfolder(i, j)) then
              if Ucase(subfolder(i, j)) ="W" Then
                .createfolder strpath & "\" & subfolder(i, j)
              end if
          end if
 
Upvote 0
Em đã thử thêm vào nhưng không chạy, Bác ơi.
Bác giúm Em: nghĩa là Khi cột J có chữ “W” thì mới tạo Folder “W” còn ngoài ra cột J có chữ gì hoặc để trong cũng không tạo. Nha Bác
Thanhs Bac!
 
Lần chỉnh sửa cuối:
Upvote 0
quanghai1969 đã viết:
Được. Thêm tí nữa

PHP: 
           if not .folderexists(strpath & "\" & subfolder(i, j)) then
              if Ucase(subfolder(i, j)) ="W" Then
                .createfolder strpath & "\" & subfolder(i, j)
              end if
          end if
Nhấp chuột vào đây để mở rộng...

Chủ top muốn tạo Folder khi i có chữ "H" thì tạo Foleder "H", tương tự cột j có chữ "W" thì tạo Folder "W", ngoài ra những chữ khác thì không tạo Folder đúng không
 
Upvote 0
toangiaphat đã viết:
Em đã thử thêm vào nhưng không chạy, Bác ơi.
Bác giúm Em: nghĩa là Khi cột J có chữ “W” thì mới tạo Folder “W” còn ngoài ra cột J có chữ gì hoặc để trong cũng không tạo. Nha Bác
Thanhs Bac!
Nhấp chuột vào đây để mở rộng...
1. Code lỗi không chạy được
2. Code chạy được nhưng ra kết quả không đúng, và nếu không đúng thì không đúng thế nào. Vui lòng minh hoạ chi tiết nếu còn có nhu cầu cần hỗ trợ tiếp.

Giao tiếp qua mạng mà mọi người cứ bắt phải đoán ý nhau kiểu này thì cũng hơi đuối.
 
Upvote 0
quanghai1969 đã viết:
Được. Thêm tí nữa

PHP: 
           if not .folderexists(strpath & "\" & subfolder(i, j)) then
              if Ucase(subfolder(i, j)) ="W" Then
                .createfolder strpath & "\" & subfolder(i, j)
              end if
          end if
Nhấp chuột vào đây để mở rộng...

Bác cho hỏi code trên thêm vào đoạn nào?
Khi cột J có chữ “W” thì mới tạo Folder “W” còn ngoài ra cột J có chữ gì hoặc để trong cũng không tạo. Nha Bác
 
Upvote 0
Mình đang chờ đáp án cuối của bài này.
Ngoài Bác Hải có thêm cao thủ nào không. Tham gia vài code giúp toangiaphat cho vui.
 
Upvote 0
toangiaphat đã viết:
Bác cho hỏi code trên thêm vào đoạn nào?
Khi cột J có chữ “W” thì mới tạo Folder “W” còn ngoài ra cột J có chữ gì hoặc để trong cũng không tạo. Nha Bác
Nhấp chuột vào đây để mở rộng...
Nếu chưa trúng thì tính tiếp
PHP: 
Sub CreateFolder()
Dim path As String, SubFolder(), i, tmp, Strpath, j
SubFolder = Range([E2], [E65536].End(3)).Resize(, 6).Value
path = "D:\ROOT"
With CreateObject("Scripting.FileSystemObject")
    If Not (.FolderExists(path)) Then .CreateFolder (path)
    For i = 1 To UBound(SubFolder)
      If SubFolder(i, 5) & SubFolder(i, 6) <> Empty Then
        tmp = TV(SubFolder(i, 1) & "_" & SubFolder(i, 2))
        tmp = Replace(tmp, Space(1), "")
        Strpath = path & "\" & tmp
        If Not .FolderExists(Strpath) Then
            .CreateFolder (Strpath)
            For j = 5 To 6
               If SubFolder(i, j) <> "" Then
                  If UCase(SubFolder(i, 6)) = "W" Then
                     If Not .FolderExists(Strpath & "\" & SubFolder(i, j)) Then
                        .CreateFolder Strpath & "\" & SubFolder(i, j)
                     End If
                  End If
               End If
            Next
        End If
      End If
    Next
End With
End Sub
 
Upvote 0
Sai rồi Bác Hải ơi! Em ví dụ thế này nhé:
Ví dụ:
[TABLE="width: 436"]
[TR]
[TD]APP ID[/TD]
[TD]CLIENT[/TD]
[TD]PRODUCT CODE[/TD]
[TD]DE.HT[/TD]
[TD]HOME[/TD]
[TD]WORK[/TD]
[/TR]
[TR]
[TD]2362048[/TD]
[TD]TRANG HOÀNG DŨNG[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]2358041[/TD]
[TD]NGUYỄN CÔNG LIÊM[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2362076[/TD]
[TD]NGUYỄN THỊ HỒNG SON[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]2331972[/TD]
[TD]NGUYỄN VĂN DUỒL[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD]W30[/TD]
[/TR]
[TR]
[TD]2357667[/TD]
[TD]NGUYỄN THỊ THU[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD]BHYT[/TD]
[/TR]
[/TABLE]
Sẽ tạo Folder gồm:
Folder 2362048_TRANGHOANGDUNG chưa Folder "H" và Folder "W".
Folder 2358041_NGUYNCONGLIEN chưa Folder "H"
Folder 2362076_NGUYENTHIHONGSON chứa Folder "W"
Folder 2331972_NGUYENVANDUOL chứa Folder "H"
Folder 2357667_NGUYENTHITHU chưa Folder "H"
Nghĩa là Cột I có chữ "H" thì tạo Folder "H" và Tại cột J có chữ "W" thì tạo Folder "W". Còn lại những chữ khác hoặc để trống tại cột I và J đều không tạo Folder "H" và Folder "W".
Chủ yếu Em chỉ muốn tạo Folder H và W vào Folder App ID_Client tương ứng.
 
Upvote 0
tommysang đã viết:
Sai rồi Bác Hải ơi! Em ví dụ thế này nhé:
Ví dụ:
[TABLE="width: 436"]
[TR]
[TD]APP ID[/TD]
[TD]CLIENT[/TD]
[TD]PRODUCT CODE[/TD]
[TD]DE.HT[/TD]
[TD]HOME[/TD]
[TD]WORK[/TD]
[/TR]
[TR]
[TD]2362048[/TD]
[TD]TRANG HOÀNG DŨNG[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]2358041[/TD]
[TD]NGUYỄN CÔNG LIÊM[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2362076[/TD]
[TD]NGUYỄN THỊ HỒNG SON[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]2331972[/TD]
[TD]NGUYỄN VĂN DUỒL[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD]W30[/TD]
[/TR]
[TR]
[TD]2357667[/TD]
[TD]NGUYỄN THỊ THU[/TD]
[TD][/TD]
[TD][/TD]
[TD]H[/TD]
[TD]BHYT[/TD]
[/TR]
[/TABLE]
Sẽ tạo Folder gồm:
Folder 2362048_TRANGHOANGDUNG chưa Folder "H" và Folder "W".
Folder 2358041_NGUYNCONGLIEN chưa Folder "H"
Folder 2362076_NGUYENTHIHONGSON chứa Folder "W"
Folder 2331972_NGUYENVANDUOL chứa Folder "H"
Folder 2357667_NGUYENTHITHU chưa Folder "H"
Nghĩa là Cột I có chữ "H" thì tạo Folder "H" và Tại cột J có chữ "W" thì tạo Folder "W". Còn lại những chữ khác hoặc để trống tại cột I và J đều không tạo Folder "H" và Folder "W".
Chủ yếu Em chỉ muốn tạo Folder H và W vào Folder App ID_Client tương ứng.
Nhấp chuột vào đây để mở rộng...
Thử sửa câu lệnh
If UCase(SubFolder(i, 6)) = "W" Then
Thành
If UCase(SubFolder(i, j)) = "W" Then
 
Upvote 0
quanghai1969 đã viết:
Thử sửa câu lệnh
If UCase(SubFolder(i, 6)) = "W" Then
Thành
If UCase(SubFolder(i, j)) = "W" Then
Nhấp chuột vào đây để mở rộng...

E đã thấy Folder "W" rồi nhưng không thấy Folder "H", Bác xem giúp Em nhé.
Trong Folder 2362048_TRANGHOANGDUNG không có FOLDER "H" chỉ có FOlDER "W" tương tự các Folder kia cũng không có. Chỉ có 2362076_NGUYENTHIHONGSON là đúng chỉ cần Folder "W" vì cột I trống
Nếu có thể Bác cho Em xin số điện thoại vào Inbox của E. Để còn có dịp Em hậu ta. Em nhờ Bác quá nhiều rồi.
 
Lần chỉnh sửa cuối:
Upvote 0
toangiaphat đã viết:
E đã thấy Folder "W" rồi nhưng không thấy Folder "H", Bác xem giúp Em nhé.
Trong Folder 2362048_TRANGHOANGDUNG không có FOLDER "H" chỉ có FOlDER "W" tương tự các Folder kia cũng không có. Chỉ có 2362076_NGUYENTHIHONGSON là đúng chỉ cần Folder "W" vì cột I trống
Nếu có thể Bác cho Em xin số điện thoại vào Inbox của E. Để còn có dịp Em hậu ta. Em nhờ Bác quá nhiều rồi.
Nhấp chuột vào đây để mở rộng...
Trộn qua trộn lại 1 hồi chắc cũng được mà. Nói thiệt là mình không có test code. Toàn viết theo cảm tính thôi. Vì mấy cái này cũng không khó nên lười kiểm quá. Bạn tự kiểm tra nhé
PHP: 
Sub CreateFolder()
Dim path As String, SubFolder(), i, tmp, Strpath, j
SubFolder = Range([E2], [E65536].End(3)).Resize(, 6).Value
path = "D:\ROOT"
With CreateObject("Scripting.FileSystemObject")
    If Not (.FolderExists(path)) Then .CreateFolder (path)
    For i = 1 To UBound(SubFolder)
      If SubFolder(i, 5) & SubFolder(i, 6) <> Empty Then
        tmp = TV(SubFolder(i, 1) & "_" & SubFolder(i, 2))
        tmp = Replace(tmp, Space(1), "")
        Strpath = path & "\" & tmp
        If Not .FolderExists(Strpath) Then
            .CreateFolder (Strpath)
            For j = 5 To 6
               If SubFolder(i, j) <> "" And UCase(SubFolder(i, 6)) = "W" Then
                  If Not .FolderExists(Strpath & "\" & SubFolder(i, j)) Then
                     .CreateFolder Strpath & "\" & SubFolder(i, j)
                  End If
               End If
            Next
        End If
      End If
    Next
End With
End Sub
 
Upvote 0
quanghai1969 đã viết:
Trộn qua trộn lại 1 hồi chắc cũng được mà. Nói thiệt là mình không có test code. Toàn viết theo cảm tính thôi. Vì mấy cái này cũng không khó nên lười kiểm quá. Bạn tự kiểm tra nhé
PHP: 
Sub CreateFolder()
Dim path As String, SubFolder(), i, tmp, Strpath, j
SubFolder = Range([E2], [E65536].End(3)).Resize(, 6).Value
path = "D:\ROOT"
With CreateObject("Scripting.FileSystemObject")
    If Not (.FolderExists(path)) Then .CreateFolder (path)
    For i = 1 To UBound(SubFolder)
      If SubFolder(i, 5) & SubFolder(i, 6) <> Empty Then
        tmp = TV(SubFolder(i, 1) & "_" & SubFolder(i, 2))
        tmp = Replace(tmp, Space(1), "")
        Strpath = path & "\" & tmp
        If Not .FolderExists(Strpath) Then
            .CreateFolder (Strpath)
            For j = 5 To 6
               If SubFolder(i, j) <> "" And UCase(SubFolder(i, 6)) = "W" Then
                  If Not .FolderExists(Strpath & "\" & SubFolder(i, j)) Then
                     .CreateFolder Strpath & "\" & SubFolder(i, j)
                  End If
               End If
            Next
        End If
      End If
    Next
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Code báo lỗi tại:
tmp = TV(SubFolder(i, 1) & "_" & SubFolder(i, 2))
Bác ơi!
Mình cho code chạy nếu có "H" thì tạo "H" nếu có "W" thì tạo "W". Đươc không Bác vì. Cơ bản cột I và J không liên quan nhau.
 
Upvote 0
toangiaphat đã viết:
Code báo lỗi tại:
tmp = TV(SubFolder(i, 1) & "_" & SubFolder(i, 2))
Bác ơi!
Mình cho code chạy nếu có "H" thì tạo "H" nếu có "W" thì tạo "W". Đươc không Bác vì. Cơ bản cột I và J không liên quan nhau.
Nhấp chuột vào đây để mở rộng...

Trong file cũ có 1 Module chứa 1 Function TV, chắc là bạn tiễn nó lên đường rồi nên mới xảy ra lỗi.
 
Upvote 0
Không được Bác ơi! Cột I có "H" nhưng không thấy Folder "H". Em đang hóng Bác 24/24. Giúp Em nhé
 
Upvote 0
toangiaphat đã viết:
em gởi bác file, bác kiểm tra giùm em. Em đã xóa file root nhưng vẫn không tháy folder "h"

cám ơn bác
Nhấp chuột vào đây để mở rộng...
Vậy thử code này coi sao. Code này có kiểm tra, hy vọng trúng
PHP: 
Sub CreateFolder()
Dim path$, SubFolder(), i&, tmp$, Str$
SubFolder = Range([E2], [E65536].End(3)).Resize(, 6).Value
path = "D:\ROOT"
With CreateObject("Scripting.FileSystemObject")
   If Not .FolderExists(path) Then .CreateFolder (path)
   For i = 1 To UBound(SubFolder)
      If SubFolder(i, 5) & SubFolder(i, 6) <> Empty Then
         tmp = TV(SubFolder(i, 1) & "_" & SubFolder(i, 2))
         tmp = Replace(tmp, Space(1), "")
         Str = path & "\" & tmp
         If Not .FolderExists(Str) Then
            .CreateFolder (Str)
            If SubFolder(i, 5) <> "" Then
               If Not .FolderExists(Str & "\" & SubFolder(i, 5)) Then
                  .CreateFolder Str & "\" & SubFolder(i, 5)
               End If
            End If
            If UCase(SubFolder(i, 6)) = "W" Then
               If Not .FolderExists(Str & "\" & SubFolder(i, 6)) Then
                  .CreateFolder Str & "\" & SubFolder(i, 6)
               End If
            End If
         End If
      End If
   Next
End With
End Sub
 
Upvote 0
Bác Hải, cho E thành thật cám ơn sự hổ trợ nhiệt tình Bác.
Bác cho Em xin số điện thoại vào inbox nha. Khi nào Em đi Bình Duong sẽ alô giao lưu với Bác và hậu tạ.
 
Upvote 0
toangiaphat đã viết:
MÌnh nghe nói Excel có thể xuất folder được bạn nào biết chỉ mình nha. đang cần rất gấp.

Chuyện là vầy: mình có 2 cột gồm cột số và tên. mình muốn bấm nút lệnh trong bảng tính tự nó sẽ tạo các folder theo danh sách. Với cú pháp tao Folder : số_Tên.

nhờ cao thủ làm giúp!
Cám ơn diễn đàn
Nhấp chuột vào đây để mở rộng...
FV tỉnh nào đây cậu?
 
Upvote 0
Từ từ sẽ biết mà. File mình gởi bạn sẽ để tên
 
Upvote 0
Bác cho E hỏi, trong code có đoạn "Sub CreateFolder()Dim path$, SubFolder(), I&, tmp$, Str$
SubFolder = Range([E2], [E1255312].End(3)).Resize(, 13).Value"
Vậy "End(3))" nghĩa là gì vậy Bác. E đang sữa 1 tí nhưng bị lỗi tại đây.
Thanks
 
Upvote 0
toangiaphat đã viết:
Bác cho E hỏi, trong code có đoạn "Sub CreateFolder()Dim path$, SubFolder(), I&, tmp$, Str$
SubFolder = Range([E2], [E1255312].End(3)).Resize(, 13).Value"
Vậy "End(3))" nghĩa là gì vậy Bác. E đang sữa 1 tí nhưng bị lỗi tại đây.
Thanks
Nhấp chuột vào đây để mở rộng...
End(3) ở đây tương đương với End(xlUp) đó bạn.
 
Upvote 0
To toangiaphat
"End(3))" LÀ lấy dự liệu từ E2....E cuối cùng có dữ liệu rồi kéo qua 13 cột nữa Resize(, 13)
giải thích kiểu ngô khoai, củ quả như vậy cho rễ hiểu nha
 
Upvote 0
kieu manh đã viết:
To toangiaphat
"End(3))" LÀ lấy dự liệu từ E2....E cuối cùng có dữ liệu rồi kéo qua 13 cột nữa Resize(, 13)
giải thích kiểu ngô khoai, củ quả như vậy cho rễ hiểu nha
Nhấp chuột vào đây để mở rộng...
BẠN KIỂM TRA GIÙM MÌNH, SAO NÓ KO CHẠY, BÁO LỖI TẠI DÒNG
SubFolder = Range([E2], [E1255312].End(3)).Resize(, 13).Value
Cám ơn!
 

File đính kèm

Upvote 0
toangiaphat đã viết:
BẠN KIỂM TRA GIÙM MÌNH, SAO NÓ KO CHẠY, BÁO LỖI TẠI DÒNG
SubFolder = Range([E2], [E1255312].End(3)).Resize(, 13).Value
Cám ơn!
Nhấp chuột vào đây để mở rộng...
sửa lại dòng sau
PHP: 
SubFolder = Range([E2], [E65536].End(3)).Resize(, 13).Value
bạn tự thêm bậy vào như sau không lỗi mới lạ...code chạy tốt mà
PHP: 
SubFolder = Range([E2], [E1255312].End(3)).Resize(, 13).Value
 
Lần chỉnh sửa cuối:
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 (10 người xem)
Trả lời
6
Đọc
47
Hoàng Tuấn 868
H
N
Tạo file lưu trữ dữ liệu tự động trên excel. (3 người xem)
Trả lời
4
Đọc
47
nguyenle01
N
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
495
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian (2 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 (2 người xem)
    • 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 (1 người xem)
Trả lời
3
Đọc
128
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 (1 người xem)
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ
Trả lời
4
Đọc
86
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
73
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
67
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
288
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt (2 người xem)
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL (1 người xem)
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • 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 (1 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
607
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
142
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
122
HUONGHCKT
H
N
hàm đếm theo dòng
Trả lời
1
Đọc
102
dungpham01
D
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