Tìm ngày gần nhất bằng vba? (1 người xem)

TránhXaRa · 28/10/12

Dear GPE!
Em có một vấn đề đã nêu ở file TongHop (foder đính kèm).
Các Thầy xem vấn đề đó có cách nào thực hiện được không ạ?
Em nghĩ về hàm thì chắc là không thể rồi.
Còn VBA thì em cũng không dám chắc là có thể được.
Nhưng Em đã xem nhiều bài viết thấy có những cái không thể tưởng được Mà các Thầy vẫn có thể làm được với VBA.
Hi vọng vấn đề này cũng có thể... hihi $-\\/.$

quykiemsau · 28/10/12

TránhXaRa đã viết:
Dear GPE!
Em có một vấn đề đã nêu ở file TongHop (foder đính kèm).
Các Thầy xem vấn đề đó có cách nào thực hiện được không ạ?
Em nghĩ về hàm thì chắc là không thể rồi.
Còn VBA thì em cũng không dám chắc là có thể được.
Nhưng Em đã xem nhiều bài viết thấy có những cái không thể tưởng được Mà các Thầy vẫn có thể làm được với VBA.
Hi vọng vấn đề này cũng có thể... hihi $-\\/.$
Thầy NDU ơi! ... (^_-)!

Vấn đề này không thể làm nổi đâu Bác à!
Bác đừng có khóc gào vô ích!

Quang_Hải · 28/10/12

Hôm nay là Chủ nhật nên mọi người bận rộn thôi mà, tại sao lại khẳng định là không thể chứ. Đối với mình chuyện gì cũng có thể, nếu khó quá thì ... bỏ cuộc... thế thôi. Nhưng vấn đề này là nằm trong tầm tay mà. Kiên nhẫn nhé.

quykiemsau · 28/10/12

quanghai1969 đã viết:
Hôm nay là Chủ nhật nên mọi người bận rộn thôi mà, tại sao lại khẳng định là không thể chứ. Đối với mình chuyện gì cũng có thể, nếu khó quá thì ... bỏ cuộc... thế thôi. Nhưng vấn đề này là nằm trong tầm tay mà. Kiên nhẫn nhé.

$-\\/.$ tại vì Em nghĩ nó quá xa vời dường như là không thể nào??? nghe hơi vô lý! hì hì.. sory Bác! +-+-+-+

ndu96081631 · 28/10/12

TránhXaRa đã viết:
Dear GPE!
Em có một vấn đề đã nêu ở file TongHop (foder đính kèm).
Các Thầy xem vấn đề đó có cách nào thực hiện được không ạ?
Em nghĩ về hàm thì chắc là không thể rồi.
Còn VBA thì em cũng không dám chắc là có thể được.
Nhưng Em đã xem nhiều bài viết thấy có những cái không thể tưởng được Mà các Thầy vẫn có thể làm được với VBA.
Hi vọng vấn đề này cũng có thể... hihi $-\\/.$

VBA chắc không có vấn đề rồi nhưng nổi hứng, làm bằng công thức xem sao... Ẹc... Ẹc...
1> Đặt name:

Mã:

GetFiles =FILES(LEFT(CELL("filename",INDIRECT("A1")),FIND("[",CELL("filename",INDIRECT("A1")))-1)&"*.xls")

Mã:

GetWkb =SUBSTITUTE(GetFiles,".xls","")

Mã:

GetDate =IF(GetWkb="TongHop",0,DATE(MID(GetWkb,7,4),MID(GetWkb,4,2),LEFT(GetWkb,2)))

2> Công thức:

Mã:

=MAX(IF(GetDate<=TODAY(),GetDate,""))

Công thức mảng, phải bấm tổ hợp phím Ctrl + Shift + Enter để kết thúc
-------------
Nói thêm: Nếu tên file được đặt theo định dạng yyyy/mm/dd thì càng.. quá khỏe luôn

Quang_Hải · 28/10/12

TránhXaRa đã viết:
Dear GPE!
Em có một vấn đề đã nêu ở file TongHop (foder đính kèm).
Các Thầy xem vấn đề đó có cách nào thực hiện được không ạ?
Em nghĩ về hàm thì chắc là không thể rồi.
Còn VBA thì em cũng không dám chắc là có thể được.
Nhưng Em đã xem nhiều bài viết thấy có những cái không thể tưởng được Mà các Thầy vẫn có thể làm được với VBA.
Hi vọng vấn đề này cũng có thể... hihi $-\\/.$

Viết vui code thế này, chắc phải sửa lại nhiều

PHP:

Sub Lay_Ten_File()
Application.ScreenUpdating = False
Dim  i As Long, FN, kq
    With Application.FileSearch
        .SearchSubFolders = True
        .LookIn = ThisWorkbook.Path
        .Filename = "*.xls"
        If .Execute() = 0 Then End
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
               FN = .FoundFiles(i)
               FN = Right(FN, Len(FN) - InStrRev(FN, "\"))
               If FN <> ThisWorkbook.Name Then
                  FN = Left(FN, InStrRev(FN, ".") - 1)
                  FN = CDate(FN)
                  If FN < Date Then
                     If FN < kq Then
                        kq = kq
                     Else
                        kq = FN
                     End If
                  End If
               End If
            Next
        End If
    End With
MsgBox kq
Application.ScreenUpdating = True
End Sub

quykiemsau · 28/10/12

.........................................................................

dhn46 · 28/10/12

Nếu thư mục của bạn ấy chỉ gồm *.xls thì em nghĩ dùng cái này nhanh hơn

Mã:

Sub FindFiles()


    Dim fleItem As Object
    Dim sFilePath As String, sFolder As String
    Dim sDay As Date


    sFilePath = ThisWorkbook.Name
    sFolder = ThisWorkbook.Path


    On Error Resume Next
    With CreateObject("Scripting.FileSystemObject")
        For Each fleItem In .GetFolder(sFolder).Files


            If fleItem.Name <> ThisWorkbook.Name Then
                If DateSerial(Mid(fleItem.Name, 7, 4), Mid(fleItem.Name, 4, 2), Day(Left(fleItem.Name, 2))) > sDay And DateSerial(Mid(fleItem.Name, 7, 4), Mid(fleItem.Name, 4, 2), Left(fleItem.Name, 2)) <= Now Then
                    sDay = DateSerial(Mid(fleItem.Name, 7, 4), Mid(fleItem.Name, 4, 2), Left(fleItem.Name, 2))
                End If
            End If
        Next
    End With
    
MsgBox sDay


End Sub

Quang_Hải · 28/10/12

QuỷKiếmSầu đã viết:
$-\\/.$ tại vì Em nghĩ nó quá xa vời dường như là không thể nào??? nghe hơi vô lý! hì hì.. sory Bác!

Thấy chưa mình đã nói là cái này nhìn sơ qua là biết không phải khó. Có thể còn nhiều cách nữa đấy. Có cầu thì tự nhiên có cung thôi.

quykiemsau · 28/10/12

quanghai1969 đã viết:
Thấy chưa mình đã nói là cái này nhìn sơ qua là biết không phải khó. Có thể còn nhiều cách nữa đấy. Có cầu thì tự nhiên có cung thôi.

Sợ nhỉ!!!! Tks!
Xin hỏi Thêm nếu file đuôi lung tung thì có được không?(Các dạng đuôi của Excel), hay là thêm đuôi .doc nữa

.
Còn ngày tháng vẫn mặc định theo 1 thể thống nhất "dd-mm-yyyy" hoac "yyyy/mm/dd"

Hoàng Trọng Nghĩa · 28/10/12

quanghai1969 đã viết:
Thấy chưa mình đã nói là cái này nhìn sơ qua là biết không phải khó. Có thể còn nhiều cách nữa đấy. Có cầu thì tự nhiên có cung thôi.

Thấy các bài dạng này, kể cả ẩn file, giấu file gì gì đó, tham gia cho vui thì được, tôi chẳng thích nên chẳng buồn làm, chứ không khó gì mà ai đó "khích tướng" chẳng bao giờ làm được nghe thật buồn cười!

Nhưng thật tình, công thức của Thầy NDU thật độc đáo!

Cũng công nhận, quanghai1969 là một trong những người sử dụng "vợ ba" thật sáng giá!

Quang_Hải · 28/10/12

QuỷKiếmSầu đã viết:
Sợ nhỉ!!!! Tks!
Xin hỏi Thêm nếu file đuôi lung tung thì có được không?(Các dạng đuôi của Excel), hay là thêm đuôi .doc nữa .
Còn ngày tháng vẫn mặc định theo 1 thể thống nhất "dd-mm-yyyy" hoac "yyyy/mm/dd"

Nếu không phân biệt đuôi thì đơn giản hơn 1 chút rồi

ndu96081631 · 28/10/12

Code liệt kê file trong thư mục người ta viết từ đời nào, giờ cứ lấy ra mà xơi thôi:

Mã:

Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
  Dim sComm As String, tmp As String, tmpFile, Arr
  On Error Resume Next
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  Folder = """" & Folder & """"
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-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 GetListFile = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function

Viết 1 Sub nữa cho toàn bộ tên file vào 1 Array

PHP:

Arr = GetListFile(Thisworkbook.Path , "*.xls", FALSE)

Tới đây đã xong hơn 1/2 rồi đấy ---> Duyệt trong Arr, lọc ra cái mình cần
--------------------------------------
Các bạn viết code nên tập thói quen phân chia công việc theo từng cụm, cái gì có sẵn cứ lấy ra mà xài ---> Kiểu viết code 1 lèo giải quyết toàn bộ công việc sẽ chẳng giúp ích được gì, vì nó chỉ giải quyết 1 bài toán cụ thế mà không mang tính tổng quát. Ví dụ bài này, ta sẽ phân chia ra thành 2 nhóm:
- Nhóm 1: Liệt kê file cho vào 1 Array (Sub có sẵn)
- Nhóm 2: Lọc ra những tên file đúng yêu cầu
Có thể cách làm mà tôi vừa nêu sẽ dài dòng nhưng chắc chắn là chuyên nghiệp hơn rất nhiều ----> mỗi người cũng phải có trong tay vài Sub, Function... gọi là ĐỒ NGHỀ chứ, cần thì lây ra mà.. quất

ndu96081631 · 29/10/12

Tôi sẽ làm bài này theo như những gì đã phân tích ở trên:
1> Hàm hổ trợ:

Mã:

Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
  Dim sComm As String, tmp As String, tmpFile, Arr
  On Error Resume Next
  GetListFile = ""
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  Folder = """" & Folder & """"
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-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 GetListFile = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function

2> Hàm chính:

Mã:

Function GetMaxDate(Optional ByVal Folder) As Long
  Dim Arr, tmp
  Dim lMax As Long, i As Long, tmpDate As Long
  On Error Resume Next
  Application.Volatile
  If IsMissing(Folder) Then Folder = ThisWorkbook.Path
  Arr = GetListFile(Folder, "[COLOR=#0000cd]??-??-????.xls[/COLOR]", False)
  If IsArray(Arr) Then
    For i = LBound(Arr) To UBound(Arr)
      tmp = Split(Left(Arr(i), 10), "-")
      tmpDate = DateSerial(tmp(2), tmp(1), tmp(0))
      If CLng(tmpDate) <= CLng(Date) Then
        If lMax < CLng(tmpDate) Then lMax = CLng(tmpDate)
      End If
    Next
  End If
  GetMaxDate = lMax
End Function

3> Áp dụng:
Gõ lên bảng tính công thức
=GetMaxDate(A1)
Với A1 là đường dẫn folder
Hoặc nếu các file cần lấy nằm cũng folder chứa file TongHop thì chỉ cần gõ
=GetMaxDate()
------------------
Chú ý chổ màu xanh ("??-??-????.xls")... ăn tiền là chổ này. Nếu viết code theo dạng thông thường các bạn cũng có thể dùng toán tử Like so sánh tương tự

KUMI · 29/10/12

ndu96081631 đã viết:
VBA chắc không có vấn đề rồi nhưng nổi hứng, làm bằng công thức xem sao... Ẹc... Ẹc...
1> Đặt name:

Mã:

GetFiles =FILES(LEFT(CELL("filename",INDIRECT("A1")),FIND("[",CELL("filename",INDIRECT("A1")))-1)&"*.xls")

Mã:

GetWkb =SUBSTITUTE(GetFiles,".xls","")

Mã:

GetDate =IF(GetWkb="TongHop",0,DATE(MID(GetWkb,7,4),MID(GetWkb,4,2),LEFT(GetWkb,2)))

2> Công thức:

Mã:

=MAX(IF(GetDate<=TODAY(),GetDate,""))

Công thức mảng, phải bấm tổ hợp phím Ctrl + Shift + Enter để kết thúc

... Híc! Thầy ơi, thật sự là Siêu Việt quá Thầy ạ!... Cái Đầu của Thầy nó không bị đau ạ! hihi ! ^^
Nhưng mà,có một đoạn này Em thử mà không được!

ndu96081631 đã viết:
Nói thêm: Nếu tên file được đặt theo định dạng yyyy/mm/dd thì càng.. quá khỏe luôn

Thứ nhất là:Tên fie cái dấu "/" em không đặt được(máy không cho đặt).
Thứ hai là:Tên File Em đặt theo định dạng "yyyy-mm-dd" thì công thức bị lỗi.
(foder đính kèm ạ)
Thứ ba là ví dụ có những file khác lưu cùng mà không định dạng theo ngày tháng
thì công thức dưới đây sẽ phải sửa lại ạ?

Mã:

GetDate =IF(GetWkb="TongHop",0,DATE(MID(GetWkb,7,4),MID(GetWkb,4,2),LEFT(GetWkb,2)))

như làThêm mấy cái Or nếu có bấy nhiêu file khác định dạng ngày tháng?

Mã:

GetDate =IF(or(GetWkb="TongHop",GetWkb="New Microsoft Excel Worksheet"),0,DATE(MID(GetWkb,7,4),MID(GetWkb,4,2),LEFT(GetWkb,2)))

Trường hợp này nếu nhiều người dùng chung chẳng may họ vô tính đưa 1 cái file nào đó vào foder này nếu không biết xử lý, thì sẽ bị lỗi phải không ạ?
Có cách nào khắc phục được tình trạng này không ạ?
Ví dụ như là ta Chỉ xét những file có tên định dạng theo ngày tháng "dd-mm-yyyy" thôi. Còn những tên khác không xét đến ;iệu có được không ạ?
Hjhj,,, đưa ra một ý tưởng thì dễ còn làm được hay không thì lại là một chuyện đầy gian nan.(mọi người đừng cười nhé)!

ndu96081631 · 29/10/12

KUMI đã viết:
Thứ nhất là:Tên fie cái dấu "/" em không đặt được(máy không cho đặt).

Cái này tại tôi nhầm ---> Thay dấu "/" thành "-" cũng được

KUMI đã viết:
Thứ hai là:Tên File Em đặt theo định dạng "yyyy-mm-dd" thì công thức bị lỗi.
(foder đính kèm ạ)
Thứ ba là ví dụ có những file khác lưu cùng mà không định dạng theo ngày tháng
thì công thức dưới đây sẽ phải sửa lại ạ?

Mã:

GetDate =IF(GetWkb="TongHop",0,DATE(MID(GetWkb,7,4),MID(GetWkb,4,2),LEFT(GetWkb,2)))

như làThêm mấy cái Or nếu có bấy nhiêu file khác định dạng ngày tháng?

Mã:

GetDate =IF(or(GetWkb="TongHop",GetWkb="New Microsoft Excel Worksheet"),0,DATE(MID(GetWkb,7,4),MID(GetWkb,4,2),LEFT(GetWkb,2)))

Trường hợp này nếu nhiều người dùng chung chẳng may họ vô tính đưa 1 cái file nào đó vào foder này nếu không biết xử lý, thì sẽ bị lỗi phải không ạ?
Có cách nào khắc phục được tình trạng này không ạ?
Ví dụ như là ta Chỉ xét những file có tên định dạng theo ngày tháng "dd-mm-yyyy" thôi. Còn những tên khác không xét đến ;iệu có được không ạ?
Hjhj,,, đưa ra một ý tưởng thì dễ còn làm được hay không thì lại là một chuyện đầy gian nan.(mọi người đừng cười nhé)!

Nếu các file được định dạng thành yyyy-mm-dd (hoặc dd-MMM-yyyy) thì bạn chỉ cần sửa name GetDate thành vầy là được

Mã:

GetDate =IF(ISERROR(1*GetWkb),0,1*GetWkb)

Các name và công thức khác giữ nguyên
Ngắn gọn là ở chổ này đây (chỉ cần nhân với 1)
Vậy là giải quyết được hết cái Thứ hai, thứ ba, thứ tư gì gì đó của bạn rồi nhé (khỏi phải OR, AND gì ráo)
------------------

KUMI đã viết:
Cái Đầu của Thầy nó không bị đau ạ! hihi ! ^^

Như tôi nói ở trên! Tôi luôn có ĐỒ NGHỀ sẵn sàng. Khi gặp 1 bài toán thì phân tích để xem cần những công cụ nào mà tôi đang có sẵn ---> Thế là cứ lấy ra, viết thêm hoặc chỉnh sửa một chút là xài được
(bởi vậy nhiều khi các bạn thắc mắc tại sao tôi viết code rất nhanh là lý do này đấy)
Ẹc... Ẹc...

Tìm ngày gần nhất bằng vba? (1 người xem)

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

Thành viên mới

File đính kèm

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Huyền thoại GPE

File đính kèm

Thành viên gạo cội

Thành viên chính thức

Hướng tới tương lai

Thành viên gạo cội

Thành viên chính thức

Chuyên gia GPE

Thành viên gạo cội

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

Bụi phấn

File đính kèm

Huyền thoại GPE

Đếm ngược thời gian