Sửa lỗi code điền từ ngày đến ngày (theo hàng ngang)

[hoangtuaotrang_hp_vn]

Em chào các anh/chị

Em có tìm code trên mạng để tự động điền ngày (trong khoảng: Từ ngày..... đến ngày....) theo hàng ngang
Nhưng đang gặp 1 số lỗi này, mong anh/chị hỗ trợ để khắc phục tình trạng lỗi ạ

 

[TongDe]

Gợi ý: Sử dụng hàm max, min để chọn ngày nhỏ đến lớn,
Data validtion để buộc nhập dạng ngày vào 2 cells đó.

 

[ptm0412]

Sao không dùng hàm Sequence. Tôi thấy bạn có dùng Excel 365.
Nếu là lỗi code thì phải có code mới sửa được, nói khơi khơi thì:

Select Case True
    Case [B3].Value = [B2].Value
        Viết thêm Code cho 1 ô duy nhất
    Case [B3].Value > [B2].Value
        Code hiện tại
    Case [B2].Value >[B3].Value
        Msgbox "Ngày sau phải lớn hơn ngày trước"
        Exit Sub
    Case [B3].value ="" Or [B2].Value = ""
        Msgbox "Không được bỏ trống"
        Exit Sub
End Select

 

[Quang_Hải]

Em chào các anh/chị

Em có tìm code trên mạng để tự động điền ngày (trong khoảng: Từ ngày..... đến ngày....) theo hàng ngang
Nhưng đang gặp 1 số lỗi này, mong anh/chị hỗ trợ để khắc phục tình trạng lỗi ạ

View attachment 281086

View attachment 281087

Sub Horizontally_fill()
Dim j As Long, Res()
Dim NgayDau As Date, NgayCuoi As Date
With Sheet1
   NgayDau = .Range("B2").value
   NgayCuoi = .Range("B3").value
   If NgayDau > NgayCuoi Then End
   If NgayDau = Empty Or NgayCuoi = Empty Then End
   For j = 1 To NgayCuoi - NgayDau + 1
      ReDim Preserve Res(1 To 2, 1 To j)
      Res(1, j) = NgayDau + j - 1
      Res(2, j) = Application.WeekNum(Res(1, j))
   Next
   .Range("D3").Resize(2, 100).ClearContents
   .Range("D3").Resize(UBound(Res), UBound(Res, 2)) = Res
End With
End Sub

Thay code này vào thử coi được bao nhiêu % mong muốn

 

[hoangtuaotrang_hp_vn]

Sub Horizontally_fill()
Dim j As Long, Res()
Dim NgayDau As Date, NgayCuoi As Date
With Sheet1
   NgayDau = .Range("B2").value
   NgayCuoi = .Range("B3").value
   If NgayDau > NgayCuoi Then End
   If NgayDau = Empty Or NgayCuoi = Empty Then End
   For j = 1 To NgayCuoi - NgayDau + 1
      ReDim Preserve Res(1 To 2, 1 To j)
      Res(1, j) = NgayDau + j - 1
      Res(2, j) = Application.WeekNum(Res(1, j))
   Next
   .Range("D3").Resize(2, 100).ClearContents
   .Range("D3").Resize(UBound(Res), UBound(Res, 2)) = Res
End With
End Sub

Thay code này vào thử coi được bao nhiêu % mong muốn

Đúng với mong muốn 1~3 rồi ạ,
Em cảm ơn anh nhiều nhé