Xin chào các a/c GPE
Mình có nhiều flie, mỗi file có nhiều sheet, tên sheet cũng là tên mã hàng,
mình muốn lấy tên các sheet đó bỏ vào 1 file"thongke.mahang"
khi chạy code thì các file đó vẫn đóng, chỉ có file "thongke.mahang" là mở. sau khi chạy xong mình sẽ biết được có tất cả bao nhiệu mã hàng
Xin chào các a/c GPE
Mình có nhiều flie, mỗi file có nhiều sheet, tên sheet cũng là tên mã hàng,
mình muốn lấy tên các sheet đó bỏ vào 1 file"thongke.mahang"
khi chạy code thì các file đó vẫn đóng, chỉ có file "thongke.mahang" là mở. sau khi chạy xong mình sẽ biết được có tất cả bao nhiệu mã hàng
không mở file thì chắc là phải xài ADO, cái này mình thua
thôi thì lén lén mở nó ra, lấy xong tên sheet rồi đóng nó lại
Mã:
Sub MaHang(Optional sPath As Variant)
Dim WB As Workbook, sFile As String, WS As Worksheet, arr(), k As Long
Application.ScreenUpdating = False
If IsMissing(sPath) Then
sPath = ThisWorkbook.Path 'ban hay khai báo l?i duong dan cho phu hop
sFile = Dir(sPath & "\*.xlsx")
End If
Do While sFile <> ""
Set WB = Workbooks.Open(sFile)
For Each WS In Worksheets
k = k + 1
ReDim Preserve arr(1 To k)
arr(k) = WS.Name
Next
WB.Close False
sFile = Dir()
Loop
[a2:a10000].Clear
[a2].Resize(k).Value = Application.WorksheetFunction.Transpose(arr)
Application.ScreenUpdating = True
End Sub
không mở file thì chắc là phải xài ADO, cái này mình thua
thôi thì lén lén mở nó ra, lấy xong tên sheet rồi đóng nó lại
Mã:
Sub MaHang(Optional sPath As Variant)
Dim WB As Workbook, sFile As String, WS As Worksheet, arr(), k As Long
Application.ScreenUpdating = False
If IsMissing(sPath) Then
sPath = ThisWorkbook.Path 'ban hay khai báo l?i duong dan cho phu hop
sFile = Dir(sPath & "\*.xlsx")
End If
Do While sFile <> ""
Set WB = Workbooks.Open(sFile)
For Each WS In Worksheets
k = k + 1
ReDim Preserve arr(1 To k)
arr(k) = WS.Name
Next
WB.Close False
sFile = Dir()
Loop
[a2:a10000].Clear
[a2].Resize(k).Value = Application.WorksheetFunction.Transpose(arr)
Application.ScreenUpdating = True
End Sub
không hiểu ý anh, đoạn code trên để test gì vậy anh? sao lại thay "msgbox" thành "Mahang"?
à, hiểu rồi, đoạn code trong file đính kèm đó hả? cái đó quên xoá..............hehehehe
đó là đường dẫn của bạn hả?
chắc ko? tôi chỉ ví dụ thôi nha, tôi ko biết là file của bạn để ở đâu
bạn hãy mở "My computer" rồi đi đến file folder cuối cùng chứa "mahang1", "mahang2"
copy lại cái đường dẫn đó
với lại xem lại cái đuôi file nữa "xls" (2003) hay "xlsx"
đó là đường dẫn của bạn hả?
chắc ko? tôi chỉ ví dụ thôi nha, tôi ko biết là file của bạn để ở đâu
bạn hãy mở "My computer" rồi đi đến file folder cuối cùng chứa "mahang1", "mahang2"
copy lại cái đường dẫn đó
với lại xem lại cái đuôi file nữa "xls" (2003) hay "xlsx"
ừm sao kỳ hén, hồi chiều tôi test thấy nó chạy ngon lành rồi, tôi mới đưa lên
thử thêm lần nữa, ko được thì chạy luôn heheheh
Mã:
Sub MaHang(Optional sPath As Variant)
Dim WB As Workbook, sFile As String, WS As Worksheet, arr(), k As Long
Application.ScreenUpdating = False
If IsMissing(sPath) Then
sPath = ThisWorkbook.Path 'ban hay khai báo l?i duong dan cho phu hop
sFile = Dir(sPath & "\" & "*.xlsx")
End If
Do While sFile <> ""
Set WB = Workbooks.Open[COLOR=#0000ff](sPath & "\" & sFile)[/COLOR]
For Each WS In Worksheets
k = k + 1
ReDim Preserve arr(1 To k)
arr(k) = WS.Name
Next
WB.Close False
sFile = Dir()
Loop
[a2:a10000].Clear
[a2].Resize(k).Value = Application.WorksheetFunction.Transpose(arr)
Application.ScreenUpdating = True
End Sub
ừm sao kỳ hén, hồi chiều tôi test thấy nó chạy ngon lành rồi, tôi mới đưa lên
thử thêm lần nữa, ko được thì chạy luôn heheheh
Mã:
Sub MaHang(Optional sPath As Variant)
Dim WB As Workbook, sFile As String, WS As Worksheet, arr(), k As Long
Application.ScreenUpdating = False
If IsMissing(sPath) Then
sPath = ThisWorkbook.Path 'ban hay khai báo l?i duong dan cho phu hop
sFile = Dir(sPath & "\" & "*.xlsx")
End If
Do While sFile <> ""
Set WB = Workbooks.Open[COLOR=#0000ff](sPath & "\" & sFile)[/COLOR]
For Each WS In Worksheets
k = k + 1
ReDim Preserve arr(1 To k)
arr(k) = WS.Name
Next
WB.Close False
sFile = Dir()
Loop
[a2:a10000].Clear
[a2].Resize(k).Value = Application.WorksheetFunction.Transpose(arr)
Application.ScreenUpdating = True
End Sub
Xin chào các a/c GPE
Mình có nhiều flie, mỗi file có nhiều sheet, tên sheet cũng là tên mã hàng,
mình muốn lấy tên các sheet đó bỏ vào 1 file"thongke.mahang"
khi chạy code thì các file đó vẫn đóng, chỉ có file "thongke.mahang" là mở. sau khi chạy xong mình sẽ biết được có tất cả bao nhiệu mã hàng
Thử code này xem thế nào. Hình như không xử lý được sheet tên tiếng Việt có dấu.
PHP:
Sub GetSheetNames()
Dim Con As Object, Cat As Object, Fso As Object, ObjFile
Dim Tbl As Object, Res(1 To 10000, 1 To 1), k As Long
Set Con = CreateObject("ADODB.Connection")
Set Cat = CreateObject("ADOX.Catalog")
Set Tbl = CreateObject("ADOX.Table")
Set Fso = CreateObject("Scripting.FileSystemObject")
With Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In .Files
If Left(ObjFile.Name, 1) <> "~" Then
If ObjFile <> ThisWorkbook.FullName Then
Con.Open "dsn=excel files;dbq=" & ObjFile
Cat.ActiveConnection = Con
For Each Tbl In Cat.Tables
k = k + 1
Res(k, 1) = Replace(Replace(Tbl.Name, "$", ""), "'", "")
Next
Con.Close
End If
End If
Next
End With
Sheets("MAHANG").[A2].Resize(k) = Res
End Sub
Thử code này xem thế nào. Hình như không xử lý được sheet tên tiếng Việt có dấu.
PHP:
Sub GetSheetNames()
Dim Con As Object, Cat As Object, Fso As Object, ObjFile
Dim Tbl As Object, Res(1 To 10000, 1 To 1), k As Long
Set Con = CreateObject("ADODB.Connection")
Set Cat = CreateObject("ADOX.Catalog")
Set Tbl = CreateObject("ADOX.Table")
Set Fso = CreateObject("Scripting.FileSystemObject")
With Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In .Files
If Left(ObjFile.Name, 1) <> "~" Then
If ObjFile <> ThisWorkbook.FullName Then
Con.Open "dsn=excel files;dbq=" & ObjFile
Cat.ActiveConnection = Con
For Each Tbl In Cat.Tables
k = k + 1
Res(k, 1) = Replace(Replace(Tbl.Name, "$", ""), "'", "")
Next
Con.Close
End If
End If
Next
End With
Sheets("MAHANG").[A2].Resize(k) = Res
End Sub
Nói thật lòng là mình nhặt code của các thành viên trên diễn đàn rồi pha chế lại thôi, chứ không hiểu bản chất của nó đâu. Mấy cái này mình ít khi viết nên kém lắm.
Function GetSheets([COLOR=#ff0000]ByVal InThisFile As Boolean[/COLOR], ParamArray ExcelFiles())
Dim Dbs As Object, db As Object
Dim tbItem, aTmp, item, arr(), tmp As String
Dim n As Long, i As Long, lVersn As Long
lVersn = Val(Application.Version)
Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
For i = LBound(ExcelFiles) To UBound(ExcelFiles)
aTmp = ExcelFiles(i)
If Not IsArray(aTmp) Then aTmp = Array(aTmp)
For Each item In aTmp
If TypeName(item) = "String" Then
If UCase$(item) Like "*.XLS" Or UCase$(item) Like "*.XLS?" Then
[COLOR=#ff0000]If Not (UCase$(item) Like "*~$*.XLS*") Then[/COLOR]
If (CStr(item) <> ThisWorkbook.FullName) Or InThisFile Then
Set db = Dbs.OpenDatabase(CStr(item), False, False, "Excel 8.0;")
For Each tbItem In db.TableDefs
tmp = tbItem.Name
[COLOR=#ff0000]tmp = Replace(tmp, "''", "'")[/COLOR]
[COLOR=#ff0000]If Right(tmp, 1) = "$" Or Right(tmp, 2) = "$'" Then[/COLOR]
If Right(tmp, 2) = "$'" Then
tmp = Mid(tmp, 2, Len(tmp) - 3)
Else
If Right(tmp, 1) = "$" Then tmp = Left(tmp, Len(tmp) - 1)
End If
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = tmp
End If
Next
db.Close
End If
End If
End If
End If
Next
Next
If n Then GetSheets = arr
Set Dbs = Nothing
End Function
Mã:
Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
ByVal Search As String, ByVal InSub As Boolean)
'ListType = True: Get Files list
'ListType = False: Get Folders list
Dim sComm As String, tmp As String, str As String, tmpFile, arr
On Error Resume Next
If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
str = """" & RootFolder & Search & """"
With CreateObject("Scripting.FileSystemObject")
tmpFile = .GetTempName
'sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D-S" & IIf(InSub, "/S", " ") & " >" & tmpFile
sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D" & IIf(InSub, "/S", " ") & " >" & tmpFile
CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
With .OpenTextFile(tmpFile, 1, , -2)
tmp = Trim(.ReadAll)
If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
If Len(tmp) Then
If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)
FilesFoldersList = Split(tmp, vbCrLf)
End If
.Close
End With
End With
Kill tmpFile
End Function
Mã:
Sub Main()
Dim path As String
Dim aFiles, aRes
Sheet1.Range("A2:A10000").ClearContents
path = ThisWorkbook.path
aFiles = FilesFoldersList(path, True, "*.xls", False)
If IsArray(aFiles) Then
aRes = GetSheets(False, aFiles)
If IsArray(aRes) Then
Sheet1.Range("A2").Resize(UBound(aRes)).Value = WorksheetFunction.Transpose(aRes)
End If
End If
End Sub
Tên file tiếng Việt hoặc tên Sheet tiếng Việt gì cũng chơi tuốt
-----------------
Một vài giải thích:
- Hàm GetSheets cho phép lấy tên sheet với đối số đầu vào ExcelFiles là mảng gồm nhiều file cùng lúc
- Hàm GetSheets có thêm đối số InThisFile với ngụ ý cho phép lấy tên sheet của chính file chứa code hoặc không (trong trường hợp file chứa code nằm cùng thư mục với các file cần lấy)
- Trong trường hợp các bạn mở 1 file Excel lên, Windows sẽ tạo ra 1 file tạm có tên dạng ~$Tên file. Vậy nên ta cần có đoạn code If Not (UCase$(item) Like "*~$*.XLS*") Then để loại bỏ file tạm này (khi bạn lấy tên sheet từ file mà file ấy đang mở)
- Nếu trong tên sheet có ký tự ' (dấu nháy đơn) thì DAO sẽ nhân ký tự này thành 2. Vậy nên ta có đoạn code này tmp = Replace(tmp, "''", "'")
- DAO sẽ xem Name Range cũng là 1 Table và lấy luôn. Điểm phân biệt giữa Sheet và Name Range là tên sheet sẽ kết thúc bằng ký tự $ hoặc $'. Vậy ta cũng có đoạn code này If Right(tmp, 1) = "$" Or Right(tmp, 2) = "$'" Then để chỉ lấy tên sheet chứ không lấy Name
-------------------
Trong file đính kèm các bạn có thể bấm nút lệnh để lấy tên sheet, hoặc cũng có thể gõ hàm trực tiếp trên cell bằng cách quét chọn vài cell theo chiều dọc (A2:A20 chẳng hạn) rồi gõ lên thanh Formula công thức:
Xem xong code bài 16 muốn nhập viện luôn
Nếu ai nhát và né code bài 16 thì dùng code đơn giản này cũng chơi được tiếng việt có dấu.
PHP:
Sub GetAllSheetNames()
Dim Fso As Object, ObjFile, sh
Dim Res(1 To 10000, 1 To 1), k As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
With Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In .Files
If Left(ObjFile.Name, 1) <> "~" Then
If ObjFile <> ThisWorkbook.FullName Then
With Workbooks.Open(ObjFile)
For Each sh In ActiveWorkbook.Sheets
k = k + 1
Res(k, 1) = sh.Name
Next
.Close
End With
End If
End If
Next
End With
Sheets("MAHANG").[A2].Resize(k) = Res
End Sub
Xem xong code bài 16 muốn nhập viện luôn
Nếu ai nhát và né code bài 16 thì dùng code đơn giản này cũng chơi được tiếng việt có dấu.
PHP:
Sub GetAllSheetNames()
Dim Fso As Object, ObjFile, sh
Dim Res(1 To 10000, 1 To 1), k As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
With Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In .Files
If Left(ObjFile.Name, 1) <> "~" Then
If ObjFile <> ThisWorkbook.FullName Then
With Workbooks.Open(ObjFile)
For Each sh In ActiveWorkbook.Sheets
k = k + 1
Res(k, 1) = sh.Name
Next
.Close
End With
End If
End If
Next
End With
Sheets("MAHANG").[A2].Resize(k) = Res
End Sub
Mở file trực tiếp là giải pháp đơn giản nhất nhưng sẽ rất phiền vì:
- File cần mở chứa vài chục ngàn objects, names hoặc stypes rác ---> Treo máy luôn
- Nếu file ta cần đang mở thì không cần mở nữa, nếu không code sẽ báo lỗi
- Phương pháp mở trực tiếp sẽ không thực hiện được với file đang bị lỗi
vân vân... và... mây mây. Ai mà biết cái gì trong trái ổi
Lỡ phóng lao rồi ráng đeo theo anh NDU bài này
Code này hình như xử được tiếng Việt đây.
PHP:
Sub GetSheetNames()
Dim Con As Object, Cat As Object, Fso As Object, ObjFile
Dim Tbl As Object, Res(1 To 10000, 1 To 1), k As Long
Set Con = CreateObject("ADODB.Connection")
Set Cat = CreateObject("ADOX.Catalog")
Set Tbl = CreateObject("ADOX.Table")
Set Fso = CreateObject("Scripting.FileSystemObject")
With Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In .Files
If Not UCase(ObjFile.Name) Like "~*.XLS*" Then
If ObjFile <> ThisWorkbook.FullName Then
Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"extended properties=excel 8.0;data source=" & ObjFile
Cat.ActiveConnection = Con
For Each Tbl In Cat.Tables
k = k + 1
Res(k, 1) = Replace(Replace(Tbl.Name, "$", ""), "'", "")
Next
Con.Close
End If
End If
Next
End With
Sheets("MAHANG").[A2].Resize(k) = Res
End Sub
Chính thống như anh NDU thì khó chứ theo kiểu Thiếu Lâm như mình thì cũng không ngại lắm.
PHP:
Sub GetSheetNames2()
Dim Con As Object, Cat As Object, Fso As Object, ObjFile
Dim Tbl As Object, Res(1 To 10000, 1 To 1), k As Long
Set Con = CreateObject("ADODB.Connection")
Set Cat = CreateObject("ADOX.Catalog")
Set Tbl = CreateObject("ADOX.Table")
Set Fso = CreateObject("Scripting.FileSystemObject")
With Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In .Files
If Not UCase(ObjFile.Name) Like "~*.XLS*" Then
If ObjFile <> ThisWorkbook.FullName Then
Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"extended properties=excel 8.0;data source=" & ObjFile
Cat.ActiveConnection = Con
For Each Tbl In Cat.Tables
k = k + 1
Res(k, 1) = Replace(Replace(Tbl.Name, "$", ""), "''", "$")
Res(k, 1) = Replace(Replace(Res(k, 1), "'", ""), "$", "'")
Next
Con.Close
End If
End If
Next
End With
Sheets("MAHANG").[A2].Resize(k) = Res
End Sub
Chính thống như anh NDU thì khó chứ theo kiểu Thiếu Lâm như mình thì cũng không ngại lắm.
PHP:
Sub GetSheetNames2()
Dim Con As Object, Cat As Object, Fso As Object, ObjFile
Dim Tbl As Object, Res(1 To 10000, 1 To 1), k As Long
Set Con = CreateObject("ADODB.Connection")
Set Cat = CreateObject("ADOX.Catalog")
Set Tbl = CreateObject("ADOX.Table")
Set Fso = CreateObject("Scripting.FileSystemObject")
With Fso.GetFolder(ThisWorkbook.Path)
For Each ObjFile In .Files
If Not UCase(ObjFile.Name) Like "~*.XLS*" Then
If ObjFile <> ThisWorkbook.FullName Then
Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"extended properties=excel 8.0;data source=" & ObjFile
Cat.ActiveConnection = Con
For Each Tbl In Cat.Tables
k = k + 1
Res(k, 1) = Replace(Replace(Tbl.Name, "$", ""), "''", "$")
Res(k, 1) = Replace(Replace(Res(k, 1), "'", ""), "$", "'")
Next
Con.Close
End If
End If
Next
End With
Sheets("MAHANG").[A2].Resize(k) = Res
End Sub
Vẫn còn nữa chứ chưa xong đâu.
Code của Hải nếu lấy tên sheet nhưng file cần lấy lại có 1 số name nào đó thì kết quả cũng sai luôn (code lấy tên sheet đồng thời lấy luôn name)
Function GetSheets([COLOR=#ff0000]ByVal InThisFile As Boolean[/COLOR], ParamArray ExcelFiles())
Dim Dbs As Object, db As Object
Dim tbItem, aTmp, item, arr(), tmp As String
Dim n As Long, i As Long, lVersn As Long
lVersn = Val(Application.Version)
Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
For i = LBound(ExcelFiles) To UBound(ExcelFiles)
aTmp = ExcelFiles(i)
If Not IsArray(aTmp) Then aTmp = Array(aTmp)
For Each item In aTmp
If TypeName(item) = "String" Then
If UCase$(item) Like "*.XLS" Or UCase$(item) Like "*.XLS?" Then
[COLOR=#ff0000]If Not (UCase$(item) Like "*~$*.XLS*") Then[/COLOR]
If (CStr(item) <> ThisWorkbook.FullName) Or InThisFile Then
Set db = Dbs.OpenDatabase(CStr(item), False, False, "Excel 8.0;")
For Each tbItem In db.TableDefs
tmp = tbItem.Name
[COLOR=#ff0000]tmp = Replace(tmp, "''", "'")[/COLOR]
[COLOR=#ff0000]If Right(tmp, 1) = "$" Or Right(tmp, 2) = "$'" Then[/COLOR]
If Right(tmp, 2) = "$'" Then
tmp = Mid(tmp, 2, Len(tmp) - 3)
Else
If Right(tmp, 1) = "$" Then tmp = Left(tmp, Len(tmp) - 1)
End If
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = tmp
End If
Next
db.Close
End If
End If
End If
End If
Next
Next
If n Then GetSheets = arr
Set Dbs = Nothing
End Function
Mã:
Function FilesFoldersList(ByVal RootFolder As String, ByVal ListType As Boolean, _
ByVal Search As String, ByVal InSub As Boolean)
'ListType = True: Get Files list
'ListType = False: Get Folders list
Dim sComm As String, tmp As String, str As String, tmpFile, arr
On Error Resume Next
If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
str = """" & RootFolder & Search & """"
With CreateObject("Scripting.FileSystemObject")
tmpFile = .GetTempName
'sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D-S" & IIf(InSub, "/S", " ") & " >" & tmpFile
sComm = "DIR " & str & " /ON /B /A" & IIf(ListType, "-", "") & "D" & IIf(InSub, "/S", " ") & " >" & tmpFile
CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
With .OpenTextFile(tmpFile, 1, , -2)
tmp = Trim(.ReadAll)
If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
If Len(tmp) Then
If InSub = False Then tmp = RootFolder & Replace(tmp, vbCrLf, vbCrLf & RootFolder)
FilesFoldersList = Split(tmp, vbCrLf)
End If
.Close
End With
End With
Kill tmpFile
End Function
Mã:
Sub Main()
Dim path As String
Dim aFiles, aRes
Sheet1.Range("A2:A10000").ClearContents
path = ThisWorkbook.path
aFiles = FilesFoldersList(path, True, "*.xls", False)
If IsArray(aFiles) Then
aRes = GetSheets(False, aFiles)
If IsArray(aRes) Then
Sheet1.Range("A2").Resize(UBound(aRes)).Value = WorksheetFunction.Transpose(aRes)
End If
End If
End Sub
Tên file tiếng Việt hoặc tên Sheet tiếng Việt gì cũng chơi tuốt
-----------------
Một vài giải thích:
- Hàm GetSheets cho phép lấy tên sheet với đối số đầu vào ExcelFiles là mảng gồm nhiều file cùng lúc
- Hàm GetSheets có thêm đối số InThisFile với ngụ ý cho phép lấy tên sheet của chính file chứa code hoặc không (trong trường hợp file chứa code nằm cùng thư mục với các file cần lấy)
- Trong trường hợp các bạn mở 1 file Excel lên, Windows sẽ tạo ra 1 file tạm có tên dạng ~$Tên file. Vậy nên ta cần có đoạn code If Not (UCase$(item) Like "*~$*.XLS*") Then để loại bỏ file tạm này (khi bạn lấy tên sheet từ file mà file ấy đang mở)
- Nếu trong tên sheet có ký tự ' (dấu nháy đơn) thì DAO sẽ nhân ký tự này thành 2. Vậy nên ta có đoạn code này tmp = Replace(tmp, "''", "'")
- DAO sẽ xem Name Range cũng là 1 Table và lấy luôn. Điểm phân biệt giữa Sheet và Name Range là tên sheet sẽ kết thúc bằng ký tự $ hoặc $'. Vậy ta cũng có đoạn code này If Right(tmp, 1) = "$" Or Right(tmp, 2) = "$'" Then để chỉ lấy tên sheet chứ không lấy Name
-------------------
Trong file đính kèm các bạn có thể bấm nút lệnh để lấy tên sheet, hoặc cũng có thể gõ hàm trực tiếp trên cell bằng cách quét chọn vài cell theo chiều dọc (A2:A20 chẳng hạn) rồi gõ lên thanh Formula công thức:
Em mạo muội thêm
tmp = tbItem.Name
tmp = Replace(tmp, "''", "'") tmp = Replace(tmp, "#", ".")
vào thì thấy OK thầy ạ.
Function rất tuyệt vời
Cảm ơn thầy.
Em mạo muội thêm
tmp = tbItem.Name
tmp = Replace(tmp, "''", "'") tmp = Replace(tmp, "#", ".")
vào thì thấy OK thầy ạ.
Function rất tuyệt vời
Cảm ơn thầy.
Giả sử tôi có 1 file gồm 4 sheet có tên lần lượt như sau: S A.1.1 S A.1#1 S A#1.1 S A#1#1 Xin hỏi các anh chị và các bạn có cách nào dùng ADO/DAO lấy dữ liệu từ 1 sheet bất kỳ trong file đó không.
Giả sử tôi có 1 file gồm 4 sheet có tên lần lượt như sau: S A.1.1 S A.1#1 S A#1.1 S A#1#1 Xin hỏi các anh chị và các bạn có cách nào dùng ADO/DAO lấy dữ liệu từ 1 sheet bất kỳ trong file đó không.
Chuẩn vậy là từ nay khỏi bàn cải hay mất công mò code nữa he .. mất thời gian ra ai biểu cứ tự làm khó mình chi vẻ ra cái tên Sheet lằng nhằng mì tôm cua
Chuẩn vậy là từ nay khỏi bàn cải hay mất công mò code nữa he .. mất thời gian ra ai biểu cứ tự làm khó mình chi vẻ ra cái tên Sheet lằng nhằng mì tôm cua
Loại bỏ các ký tự cấm thì khả năng đặt tên cũng là vô cùng lớn. Vậy tại sao cứ "phải" dùng các ký tự cấm kia? Ngay cả tên tập tin trên đĩa người ta cũng không cho dùng một loạt ký tự. Tất nhiên người ta có lý do nhưng người ta không có trách nhiệm giải thích, báo cáo với ai cả. Mà biết lý do để làm gì? Chỉ để thỏa mãn trí tò mò?
Chuẩn vậy là từ nay khỏi bàn cải hay mất công mò code nữa he .. mất thời gian ra ai biểu cứ tự làm khó mình chi vẻ ra cái tên Sheet lằng nhằng mì tôm cua
Vấn đề là không phải mình viết code cho mình mà đa phần là viết cho những dữ liệu đã có sẵn từ đời nào rồi. Họ đang có 1000 files, mỗi file chứa vài chục sheet, tất cả đã đặt tên sẵn. Giờ... làm sao? Kêu họ "ông muốn tôi viết code thì ông vui lòng mở mấy file đó và đổi hết tên sheet cho tôi"
???!!!
Chắc chắn phải có cách, chỉ là tạm thời chưa nghĩ ra thôi. Tôi sẽ lưu ý vấn đề này!
Vấn đề là không phải mình viết code cho mình mà đa phần là viết cho những dữ liệu đã có sẵn từ đời nào rồi. Họ đang có 1000 files, mỗi file chứa vài chục sheet, tất cả đã đặt tên sẵn. Giờ... làm sao? Kêu họ "ông muốn tôi viết code thì ông vui lòng mở mấy file đó và đổi hết tên sheet cho tôi"
???!!!
Chắc chắn phải có cách, chỉ là tạm thời chưa nghĩ ra thôi. Tôi sẽ lưu ý vấn đề này!
Em nghỉ vầy:
1/ nếu xài Workbook.open mở lên xong đổi tên Sheet là hạ sách
2/ nếu xài ADO đổi tên Sheet là thượng sách
...
...
Tuy nhiên mục số 2 tên sheet kiểu phạm qui của Bill thì ADO nó ko có hiểu hay hiểu linh tinh VD: 1.1 thì nó hiểu ra1#1
Mình có tham khảo trên mạng và chỉnh sửa 1 chút cho phù hợp.
Function GetSheetName(iFilePath As String)
Dim sh As Object
Set sh = GetObject(iFilePath).Worksheets
ReDim t(1 To sh.Count, 1 To 1)
Dim i
For i = 1 To sh.Count
t(i, 1) = sh(i).Name
Next i
GetSheetName = t
End Function
Sub Test()
Dim mFilePath As String
mFilePath = "C:\Users\Acer\Desktop\Deck top\Decktop\THE KHO.xlsx" 'thay bang duong dan khac
Dim t: t = GetSheetName(mFilePath)
[A1].Resize(UBound(t, 1)) = t
End Sub
Mình có tham khảo trên mạng và chỉnh sửa 1 chút cho phù hợp.
Function GetSheetName(iFilePath As String)
Dim sh As Object
Set sh = GetObject(iFilePath).Worksheets
ReDim t(1 To sh.Count, 1 To 1)
Dim i
For i = 1 To sh.Count
t(i, 1) = sh(i).Name
Next i
GetSheetName = t
End Function
Sub Test()
Dim mFilePath As String
mFilePath = "C:\Users\Acer\Desktop\Deck top\Decktop\THE KHO.xlsx" 'thay bang duong dan khac
Dim t: t = GetSheetName(mFilePath)
[A1].Resize(UBound(t, 1)) = t
End Sub
Bạn biết lý do tại sao người ta không muốn mở file rồi lấy dữ liệu không? Trong trường hợp kém may mắn, file cần lấy dữ liệu bị lỗi thì code loại này phá sản ngay. Trong khi nếu bạn dùng ADO, DAO... để lấy dữ liệu lại chẳng bị gì cả, bất kể file chứa dữ liệu có bị lỗi
Là sao bạn?
Lưu ý rằng ở đây không cần tool ẩn hiện sheet nha, chỉ muốn lấy tên sheet từ các file đang đóng thôi (mà không cần mở file). Bạn có giải pháp không?
Bạn biết lý do tại sao người ta không muốn mở file rồi lấy dữ liệu không? Trong trường hợp kém may mắn, file cần lấy dữ liệu bị lỗi thì code loại này phá sản ngay. Trong khi nếu bạn dùng ADO, DAO... để lấy dữ liệu lại chẳng bị gì cả, bất kể file chứa dữ liệu có bị lỗi
...
Theo lập trình thì tôi tránh bàn. Nhưng theo nguyên tắc import dữ liệu thì lý luận này quá chủ quan.
Nếu dữ liệu có bị lỗi thì làm cách nào biết? Thay vì code "phá sản ngay" thì quy trình "phá sản trong tương lai".
Trên thực tế, dùng ADO để lấy dữ liệu thì luôn phải có cách kiểm soát lại.
Hihi cách này hồi lúc làm cái tool mini tổng hợp dữ liệu từ các file đóng mình cũng có nghĩ tới mà vướng cái excel xls nên thôi không mò nữa, bạn viết được tool này mình thấy hay đấy
Hihi cách này hồi lúc làm cái tool mini tổng hợp dữ liệu từ các file đóng mình cũng có nghĩ tới mà vướng cái excel xls nên thôi không mò nữa, bạn viết được tool này mình thấy hay đấy
1/ làm 20 File x 20 sheet/1 file ... File nhẹ vài trăm KB
2/ làm 20 File x 20 sheet/1 file ... File trên 1 MB
...
...
Xong tính đến File họ đặt Pass Workbook, Sheet ( Ko nói pass Open ở đây nha )
xem sao xong tính tiếp ... ko cần 1000 file làm chi cả nếu muc số 2 làm OK là quá Tốt rồi đó
1/ làm 20 File x 20 sheet/1 file ... File nhẹ vài trăm KB
2/ làm 20 File x 20 sheet/1 file ... File trên 1 MB
...
...
Xong tính đến File họ đặt Pass Workbook, Sheet ( Ko nói pass Open ở đây nha )
xem sao xong tính tiếp ... ko cần 1000 file làm chi cả nếu muc số 2 làm OK là quá Tốt rồi đó
Tuỳ theo trình độ khả năng làm chủ dữ liệu của bạn.
Tức là đối với bạn, mớ dữ liệu nằm trong bảng tính sẽ giúp cho bạn quản lý công việc, hay chỉ dùng để nộp báo cáo.
Anh thấy cái chủ đề này đã 5 năm rồi nhưng chưa có kết quả mong muốn, do có nhiều nguyên nhân:
- Chủ Topic chỉ chăm bẩm vào cái tên sheet của từng File nhưng không chú tâm vào dữ liệu của từng sheet và kết quả cuối cùng mong muốn ra sao? Kông lẽ lấy tên sheet để đó xem chơi.
- Nếu đạt mục đích lấy được tên sheet của tất cả các File rồi, không lẽ lại đi hỏi tiếp làm sao lấy dữ liệu vào.
- Đúng ra chủ Topic cần phải nêu cụ thể từng bước để tạo hay lưu các File đó và kết quả mong muốn thực hiện là gì thì sẽ được nhiều người góp cho ý tưởng còn hay hơn là ôm cái ý tưởng của bản thân đến 5 năm.
Anh thấy cái chủ đề này đã 5 năm rồi nhưng chưa có kết quả mong muốn, do có nhiều nguyên nhân:
- Chủ Topic chỉ chăm bẩm vào cái tên sheet của từng File nhưng không chú tâm vào dữ liệu của từng sheet và kết quả cuối cùng mong muốn ra sao? Kông lẽ lấy tên sheet để đó xem chơi.
- Nếu đạt mục đích lấy được tên sheet của tất cả các File rồi, không lẽ lại đi hỏi tiếp làm sao lấy dữ liệu vào.
- Đúng ra chủ Topic cần phải nêu cụ thể từng bước để tạo hay lưu các File đó và kết quả mong muốn thực hiện là gì thì sẽ được nhiều người góp cho ý tưởng còn hay hơn là ôm cái ý tưởng của bản thân đến 5 năm.
lấy tên Sheet theo tiêu chí tên của Bill thì quá đơn giản rồi đó Anh ===> lấy dữ liệu + xử lý nó cũng thế
Tuy nhiên nhiều người cứ thích vẻ chuyện tự làm khó mình xong đi hỏi xử lý mấy thứ tào lao VD: như cái Web chuyển tiền Em đang xài nó xuất File Data !. csv
Em cũng không hiểu cái não nó nghỉ gì thêm cái ! vào đó xong làm khó mình khó người được hay sao ??!!
Tuỳ theo trình độ khả năng làm chủ dữ liệu của bạn.
Tức là đối với bạn, mớ dữ liệu nằm trong bảng tính sẽ giúp cho bạn quản lý công việc, hay chỉ dùng để nộp báo cáo.
ý bác đề cập tới:
+Khả năng khai thác dữ liệu sẵn có để tạo ra báo cáo hay quản ly? ( cái này hình như là năng lực xử lý dữ liệu?)
+Hay là Khả năng tổ chức dữ liệu, để làm nền, cung cấp các chức năng sau này? ( cái này hình như là năng lực tổ chức dữ liệu?)
->Trong hai cái trên, với một lính mới thì nên tập trung vào cái nào thì tốt hơn?
Cái thứ hai cần trình độ cao hơn.
Tức là bạn cần học cái nthuws nhất, nhưng lkucs nào cũng cũng nhớ rằng phải đạtn được cái thứ hai mới hy vọng quản lý được dữ liệu.
Nhưng nếu bạn làm sếp thì chỉ cần lo cái thứ nhât. Cái thứ hai chỉ cần có khái niệm để kiểm soát lính thôi.
Cái thứ hai cần trình độ cao hơn.
Tức là bạn cần học cái nthuws nhất, nhưng lkucs nào cũng cũng nhớ rằng phải đạtn được cái thứ hai mới hy vọng quản lý được dữ liệu.
Nhưng nếu bạn làm sếp thì chỉ cần lo cái thứ nhât. Cái thứ hai chỉ cần có khái niệm để kiểm soát lính thôi.
