Làm sao insert nhiều sheet, với mỗi sheet name là 1 ngày trong tháng?

Ếch Xanh · 13/11/10

Công việc của tôi, mỗi ngày mỗi khác, mẫu biểu cũng chẳng có giống nhau, vậy cho nên cứ mỗi tháng tôi lại làm 1 file excel ghi vào tháng đó, và mỗi sheet tôi đặt tên của ngày trong tháng đó, như vậy, nếu tháng 1 tôi sẽ insert 31 sheet, sheet name từ 1 đến 31.

Xin vui lòng cho tôi hỏi có code nào insert 1 lúc ra số sheet trong 1 tháng và đặt tên cho nó theo thứ tự tăng dần từ 1 đến cuối tháng đó không? Xin cảm ơn rất rất nhiều!

ndu96081631 · 13/11/10

Learning_Excel đã viết:
Công việc của tôi, mỗi ngày mỗi khác, mẫu biểu cũng chẳng có giống nhau, vậy cho nên cứ mỗi tháng tôi lại làm 1 file excel ghi vào tháng đó, và mỗi sheet tôi đặt tên của ngày trong tháng đó, như vậy, nếu tháng 1 tôi sẽ insert 31 sheet, sheet name từ 1 đến 31.

Xin vui lòng cho tôi hỏi có code nào insert 1 lúc ra số sheet trong 1 tháng và đặt tên cho nó theo thứ tự tăng dần từ 1 đến cuối tháng đó không? Xin cảm ơn rất rất nhiều!

Dễ mà chú:

PHP:

Sub DaySh()
  Dim Days As Long, i As Long
  On Error Resume Next
  Days = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
  For i = 1 To Days
    If Sheets(CStr(i)) Is Nothing Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = i
    End If
  Next
End Sub

sealand · 13/11/10

Bạn thử Code này xem:

Mã:

Sub chepSH()
Dim i, ch, Numdate
Dim Sh As Worksheet
ch = InputBox("Nhap thang nam dang: 012010 " & Chr(10) & "(Thang nam la thang 1 nam 2010)")
If Len(ch) <> 6 Or Not IsNumeric(ch) Then Exit Sub
Numdate = Day(DateSerial(Right(ch, 4), Left(ch, 2) + 1, 1) - 1)
For i = 1 To Numdate
Set Sh = ThisWorkbook.Sheets.Add
Sh.Name = Right("0" & i, 2) & "." & Left(ch, 2) & "." & Right(ch, 4)
Next
End Sub

nghiaphuc · 13/11/10

Learning_Excel đã viết:
Công việc của tôi, mỗi ngày mỗi khác, mẫu biểu cũng chẳng có giống nhau, vậy cho nên cứ mỗi tháng tôi lại làm 1 file excel ghi vào tháng đó, và mỗi sheet tôi đặt tên của ngày trong tháng đó, như vậy, nếu tháng 1 tôi sẽ insert 31 sheet, sheet name từ 1 đến 31.

Xin vui lòng cho tôi hỏi có code nào insert 1 lúc ra số sheet trong 1 tháng và đặt tên cho nó theo thứ tự tăng dần từ 1 đến cuối tháng đó không? Xin cảm ơn rất rất nhiều!

Bạn dùng tạm code này nhé:

PHP:

Sub TaoSheet()
    Dim i As Byte, m As Byte
    m = InputBox("Nhap thang")
    If Not IsNumeric(m) Or m < 1 Or m > 12 Then Exit Sub
    Sheets(1).Copy
    With ActiveWorkbook
        .Sheets.Add , .Sheets(.Sheets.Count), Day(DateSerial(Year(Date), m + 1, 1) - 1) - 1
        For i = 1 To .Sheets.Count
            .Sheets(i).Name = i '& "." & m 'Neu can thiet thi them thang trong ten Sheet
        Next i
    End With
End Sub

Ếch Xanh · 13/11/10

Cám ơn Thầy Ndu, Thầy Sealand và bạn nghiaphuc đã giúp đỡ mình về bài này. Code nào cũng chạy tốt.

Tuy nhiên, để màu mè thêm tên sheet kiểu dd-mmm (01-Nov) thì mình xin được dùng code của Thầy Ndu và chỉnh sửa lại như sau, mong các Thầy góp ý:

PHP:

Sub SheetDay()
  Dim Days As Long, i As Long
  On Error Resume Next
  Application.ScreenUpdating = False
  Days = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
  For i = 1 To Days
    If Sheets(CStr(Format(i & "/" & Month(Date), "dd-mmm"))) Is Nothing Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i & "/" & Month(Date), "dd-mmm")
    End If
  Next
  Application.ScreenUpdating = True
End Sub

Lê Duy Thương · 13/11/10

Learning_Excel đã viết:
Cám ơn Thầy Ndu, Thầy Sealand và bạn nghiaphuc đã giúp đỡ mình về bài này. Code nào cũng chạy tốt.

Tuy nhiên, để màu mè thêm tên sheet kiểu dd-mmm (01-Nov) thì mình xin được dùng code của Thầy Ndu và chỉnh sửa lại như sau, mong các Thầy góp ý:

PHP:

Sub SheetDay() Dim Days As Long, i As Long On Error Resume Next Application.ScreenUpdating = False Days = Day(DateSerial(Year(Date), Month(Date) + 1, 0)) For i = 1 To Days If Sheets(CStr(Format(i & "/" & Month(Date), "dd-mmm"))) Is Nothing Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i & "/" & Month(Date), "dd-mmm") End If Next Application.ScreenUpdating = True End Sub

có thể sửa như thế này cũng ok nè bạn

PHP:

Sub DaySh()
Dim Days As Long, i As Long
On Error Resume Next
Days = Day(DateSerial(Year(Date), Month(Date) + 2, 0))
For i = 1 To Days
If Sheets(CStr(i)) Is Nothing Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i & "-" & Month(Now()) & "-" & Year(Now()), "dd-mmm-yy")
End If
Next
End Sub

ndu96081631 · 13/11/10

Learning_Excel đã viết:
Cám ơn Thầy Ndu, Thầy Sealand và bạn nghiaphuc đã giúp đỡ mình về bài này. Code nào cũng chạy tốt.

Tuy nhiên, để màu mè thêm tên sheet kiểu dd-mmm (01-Nov) thì mình xin được dùng code của Thầy Ndu và chỉnh sửa lại như sau, mong các Thầy góp ý:

PHP:

Sub SheetDay() Dim Days As Long, i As Long On Error Resume Next Application.ScreenUpdating = False Days = Day(DateSerial(Year(Date), Month(Date) + 1, 0)) For i = 1 To Days If Sheets(CStr(Format(i & "/" & Month(Date), "dd-mmm"))) Is Nothing Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i & "/" & Month(Date), "dd-mmm") End If Next Application.ScreenUpdating = True End Sub

Nếu muốn kiểu vậy thì đừng For từ 1 đến ngày cuối tháng mà nên For từ đầu tháng đến cuối tháng sẽ dễ hiểu hơn
Như vầy đây:

PHP:

Sub SheetDay()
  Dim fDay As Long, eDay As Long, i As Long
  On Error Resume Next
  Application.ScreenUpdating = False
  fDay = DateSerial(Year(Date), Month(Date), 1)
  eDay = DateSerial(Year(Date), Month(Date) + 1, 0)
  For i = fDay To eDay
    If Sheets(Format(i, "dd-mmm")) Is Nothing Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i, "dd-mmm")
    End If
  Next
  Application.ScreenUpdating = True
End Sub

Chẳng cần đến các phép nối chuổi làm gì
-----------------------------------

Le duy Thuong đã viết:
có thể sửa như thế này cũng ok nè bạn

PHP:

Sub DaySh() Dim Days As Long, i As Long On Error Resume Next Days = Day(DateSerial(Year(Date), Month(Date) + 2, 0)) For i = 1 To Days If Sheets(CStr(i)) Is Nothing Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i & "-" & Month(Now()) & "-" & Year(Now()), "dd-mmm-yy") End If Next End Sub

Trong code này có đoạn
Days = Day(DateSerial(Year(Date), Month(Date) + 2, 0))
hình như sai à nha --> Phải + 1 chứ... Nếu không thì sẽ có 1 sheet cuối mang tên 31-11-2010 ---> Làm gì có ngày này

Ếch Xanh · 14/11/10

Le duy Thuong đã viết:
có thể sửa như thế này cũng ok nè bạn

PHP:

Sub DaySh() Dim Days As Long, i As Long On Error Resume Next Days = Day(DateSerial(Year(Date), Month(Date) + 2, 0)) For i = 1 To Days If Sheets(CStr(i)) Is Nothing Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i & "-" & Month(Now()) & "-" & Year(Now()), "dd-mmm-yy") End If Next End Sub

Trước hết là tôi cám ơn bạn đã giúp mình hoàn thiện code, nhưng ngoài vấn đề Thầy Ndu đã nói, mình cũng có vấn đề bẫy lỗi trong code của Thầy Ndu:

Đoạn code này: If Sheets(CStr(i)) Is Nothing Then, mục đích là Thầy bẫy lỗi nếu đã tồn tại sheet(i) thì bỏ qua, nên mình đã theo cấu trúc đó và làm như vầy:
If Sheets(CStr(Format(i & "/" & Month(Date), "dd-mmm"))) Is Nothing Then
nếu bạn không theo cấu trúc đó, thì mỗi lần cho chạy Macro thì mỗi lần nó tiếp tục insert sheet.

Chỉ là học hỏi lẫn nhau. Cám ơn bạn.

Ếch Xanh · 14/11/10

Mình lại kết hợp code của Thầy Ndu và thêm Inputbox kiểu của Thầy Sealand và bạn nghiaphuc như sau:

PHP:

Sub SheetDay()
  Dim fDay As Long, eDay As Long, i As Long, ipt As Integer
  On Error Resume Next
  If Sheets.Count > 10 Then Exit Sub '<=== Chỉ hơi lấn cấn cái này bẫy như thế nào cho phải.
    ipt = Application.InputBox("Nhap tu 1 den 12", "NHAP THANG", 1)
    If ipt < 1 Or ipt > 12 Then Exit Sub
      fDay = DateSerial(Year(Date), ipt, 1)
      eDay = DateSerial(Year(Date), ipt + 1, 0)
      Application.ScreenUpdating = False
      For i = fDay To eDay
        If Sheets(Format(i, "dd-mmm")) Is Nothing Then
          Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i, "dd-mmm")
        End If
      Next
      Application.ScreenUpdating = True
End Sub

Mong các Thầy, Anh Chị giúp hoàn thiện hơn.

ndu96081631 · 14/11/10

Learning_Excel đã viết:

Mình lại kết hợp code của Thầy Ndu và thêm Inputbox kiểu của Thầy Sealand và bạn nghiaphuc như sau:

PHP:

Sub SheetDay()
  Dim fDay As Long, eDay As Long, i As Long, ipt As Integer
  On Error Resume Next
  If Sheets.Count > 10 Then Exit Sub '<=== Chỉ hơi lấn cấn cái này bẫy như thế nào cho phải.
    ipt = Application.InputBox("Nhap tu 1 den 12", "NHAP THANG", 1)
    If ipt < 1 Or ipt > 12 Then Exit Sub
      fDay = DateSerial(Year(Date), ipt, 1)
      eDay = DateSerial(Year(Date), ipt + 1, 0)
      Application.ScreenUpdating = False
      For i = fDay To eDay
        If Sheets(Format(i, "dd-mmm")) Is Nothing Then
          Sheets.Add(After:=Sheets(Sheets.Count)).Name = Format(i, "dd-mmm")
        End If
      Next
      Application.ScreenUpdating = True
End Sub

Mong các Thầy, Anh Chị giúp hoàn thiện hơn.

Bạn nói rằng:

'<=== Chỉ hơi lấn cấn cái này bẫy như thế nào cho phải.

Tôi cũng thấy lấn cấn luôn vì... không hiểu!
Bạn dùng đoạn If Sheets.Count > 10 Then Exit Sub với mục đích gì?

Ếch Xanh · 14/11/10

ndu96081631 đã viết:
Bạn nói rằng:

Tôi cũng thấy lấn cấn luôn vì... không hiểu!
Bạn dùng đoạn If Sheets.Count > 10 Then Exit Sub với mục đích gì?

Thưa Thầy, tại nếu không bẫy lỗi này thì Insert theo Inputbox thì khả năng có 12 lần Insert mà như vậy thì không nên, còn bẫy lỗi thì chưa biết làm sao! Có chăng mình bấm nút lệnh xong là cho nó Enable = False luôn thì tốt.

ndu96081631 · 14/11/10

Learning_Excel đã viết:
Thưa Thầy, tại nếu không bẫy lỗi này thì Insert theo Inputbox thì khả năng có 12 lần Insert mà như vậy thì không nên, còn bẫy lỗi thì chưa biết làm sao! Có chăng mình bấm nút lệnh xong là cho nó Enable = False luôn thì tốt.

Mình vẫn chưa hiểu chổ màu đỏ! Sao lại 12 lần Insert nhỉ?
Hay ý bạn muốn code này chỉ chạy 1 lần và không cho Insert tiếp các tháng khác?

Ếch Xanh · 14/11/10

ndu96081631 đã viết:
Mình vẫn chưa hiểu chổ màu đỏ! Sao lại 12 lần Insert nhỉ?
Hay ý bạn muốn code này chỉ chạy 1 lần và không cho Insert tiếp các tháng khác?

Vâng ạ, mỗi File chỉ là một tháng, thì nên tạo một lần, nhưng lại lấn cấn chỗ nếu gõ tháng sai mà cho nút lệnh Enable thì mất công thoát ra làm lại, còn nếu bẫy lỗi thì cũng không ổn.

nghiaphuc · 14/11/10

Learning_Excel đã viết:
Vâng ạ, mỗi File chỉ là một tháng, thì nên tạo một lần, nhưng lại lấn cấn chỗ nếu gõ tháng sai mà cho nút lệnh Enable thì mất công thoát ra làm lại, còn nếu bẫy lỗi thì cũng không ổn.

Vậy thì dùng cách của mình đi, mỗi lần chạy code sẽ tạo ra 1 file cho tháng đó mà chẳng dính dáng gì đến file chứa code cả.
Sửa lại một xíu trong code:
Day(DateSerial(Year(Date), m + 1, 1) - 1) - 1
thành:
Day(DateSerial(Year(Date), m + 1, -1))
cho nó gọn gàng.
Trong đó cũng đã có bẫy lỗi cho trường hợp nhập tháng sai rồi nè:
If Not IsNumeric(m) Or m < 1 Or m > 12 Then Exit Sub

Làm sao insert nhiều sheet, với mỗi sheet name là 1 ngày trong tháng?

Ếch Xanh

Thành viên tích cực

ndu96081631

Huyền thoại GPE

sealand

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

nghiaphuc

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

File đính kèm

Ếch Xanh

Thành viên tích cực

Lê Duy Thương

Cạo lấy gì gội (Dịch quá không gội được)

ndu96081631

Huyền thoại GPE

Ếch Xanh

Thành viên tích cực

Ếch Xanh

Thành viên tích cực

ndu96081631

Huyền thoại GPE

Ếch Xanh

Thành viên tích cực

ndu96081631

Huyền thoại GPE

Ếch Xanh

Thành viên tích cực

nghiaphuc

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

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

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

Đếm ngược thời gian