Chuyển ngày thành dd/mm/yyyy khi dùng wf.Transpose(Arr)!

[ThuNghi]

Tối làm 1 code sau để tạo những ngày trong tháng và gán vào dòng 1 sh Tmp. Nhưng không thể nào chuyển ngày thành dd/mm/yyyy được, nhờ các Bác hướng dẫn giúp.
Đã set trong control Panel và format cell.

Sub thu()
Dim wf As WorksheetFunction
Set wf = WorksheetFunction
Dim fDate As Date, iDate As Date, endM As Long
fDate = DateSerial(2010, 10, 1)
endM = Day(DateSerial(Year(fDate), Month(fDate) + 1, 0))
ReDim Arr(1 To endM, 1 To 1)
For i = 1 To endM
  iDate = DateSerial(Year(fDate), Month(fDate), i)
  Arr(i, 1) = CDate(iDate)
Next i
With Sheets("Tmp").[A1]
  .Resize(1, 31).ClearContents
  .Resize(1, endM) = wf.Transpose(Arr)
End With
Set wf = Nothing
End Sub

Xin cám ơn!

 

[sealand]

Nhưng cái ngày này hiển thị ra sao là do định dạng của sheet chứ trừ phi làm cho nó không phải là date nữa

 

[ThuNghi]

Nhưng cái ngày này hiển thị ra sao là do định dạng của sheet chứ trừ phi làm cho nó không phải là date nữa

Em đã format trên sh là dd/mm/yyyy rồi mà.
Nếu không dùng wf.transpose(arr) mà gán vào từng cell thì OK.

Sub thu()
'.....'
With Sheets("Tmp").[A1]
  .Resize(1, 31).ClearContents
End With
With Sheets("Tmp")
  For i = 1 To endM
    .Cells(1, i) = arr(i, 1)
  Next i
End With
Set wf = Nothing
Erase arr
End Sub

Thì OK. Anh xem giúp em. Cám ơn anh.

 

[sealand]

Đây là code của Thu Nghi nha mình chỉ thay đổi vùng gán ngày để kiểm tra thôi. Hoàn toàn được mà

 

[ThuNghi]

Đây là code của Thu Nghi nha mình chỉ thay đổi vùng gán ngày để kiểm tra thôi. Hoàn toàn được mà

Em vẫn bị 10/01/2010, em chưa tìm ra nguyên nhân.
1/ Đã set dd/MM/yyyy trong Control Panel
2/ Đã formatcell là dd/mm/yyyy
Cám ơn anh. Em làm tiếp thì dòng kế nó chuyển thành mm/dd/yyyy cụ thể A5=10/01/2010.

Cám ơn Bác Mỹ, quán tính mà, với lại nó cũng có vấn đề khi transpose với dữ liệu là ngày.

 

[ptm0412]

Sao lại phải khổ thân tạo mảng dọc rồi Tranpose thành mảng ngang thế? Trong khi mặc định mảng 1 chiều là mảng ngang và mảng ngang thì không bị lỗi đó.
Sao không là:

ReDim Arr(endM)
For i = 1 To endM
  iDate = DateSerial(Year(fDate), Month(fDate), i)
  Arr(i) = CDate(iDate)
Next i
With Sheets("Tmp").[A1]
  .Resize(1, 31).ClearContents
  .Resize(1, endM) = Arr

 

[sealand]

Anh Mỹ phát hiện chuẩn xác. Cũng theo anh Mỹ mình thấy Code viết thế này chắc tốc độ và hiêu quả hơn . Thu Nghi tham khảo nha

Sub Thu()
Dim endM, nam As Integer, thg As Integer
thg = 10: nam = 2010
endM = Day(DateSerial(nam, thg + 1, 0))
With Sheet1.[C3]
.Value = DateSerial(nam, thg, 1)
.AutoFill .Resize(1, endM)
End With
End Sub

 

[ndu96081631]

Cách khác

Cách của anh sealand là dùng AutoFill, cũng tốt! Nếu ThuNghi muốn dùng mảng thì tôi có cái này:
- Evaluate("ROW(1:31)") là 1 mảng 31 phần tử
- Giả sử ta có fDate là ngày cuối của tháng trước thì khi ta cộng mảng trên với fDate, ta sẽ được 1 mảng là toàn bộ ngày của tháng này

Sub FillDate()
  Dim fDate As Long, Days As Long, Arr
  Const y = 2010: Const m = 10
  fDate = DateSerial(y, m, 0)
  Days = Day(DateSerial(y, m + 1, 0))
  Arr = Evaluate("TRANSPOSE(ROW(1:" & Days & "))+" & fDate)
  With Sheets("Tmp").Range("A1").Resize(, Days)
    .Resize(, 31).ClearContents
    .Value = Arr
  End With
End Sub

Có thể "chế biến" thành 1 UDF để dùng lâu dài ----> Xét về tốc độ thị không hề thua kém cách của anh sealand đâu nha (có thể thí nghiệm fill 60,000 dòng để kiểm chứng)
-----------------
Còn code của ThuNghi bị lỗi chẳng phải do Transpose đâu
Sửa chổ này
Dim fDate As Date, iDate As Date
và
Arr(i, 1) = CDate(iDate)
Thành:
Dim fDate As Long, iDate As Long
Arr(i, 1) = iDate
là hêt lỗi ngay!

 

[ThuNghi]

Cách của anh sealand là dùng AutoFill, cũng tốt! Nếu ThuNghi muốn dùng mảng thì tôi có cái này:
- Evaluate("ROW(1:31)") là 1 mảng 31 phần tử
- Giả sử ta có fDate là ngày cuối của tháng trước thì khi ta cộng mảng trên với fDate, ta sẽ được 1 mảng là toàn bộ ngày của tháng này

Sub FillDate()
  Dim fDate As Long, Days As Long, Arr
  Const y = 2010: Const m = 10
  fDate = DateSerial(y, m, 0)
  Days = Day(DateSerial(y, m + 1, 0))
  Arr = Evaluate("TRANSPOSE(ROW(1:" & Days & "))+" & fDate)
  With Sheets("Tmp").Range("A1").Resize(, Days)
    .Resize(, 31).ClearContents
    .Value = Arr
  End With
End Sub

Có thể "chế biến" thành 1 UDF để dùng lâu dài ----> Xét về tốc độ thị không hề thua kém cách của anh sealand đâu nha (có thể thí nghiệm fill 60,000 dòng để kiểm chứng)
-----------------
Còn code của ThuNghi bị lỗi chẳng phải do Transpose đâu
Sửa chổ này
Dim fDate As Date, iDate As Date
và
Arr(i, 1) = CDate(iDate)
Thành:
Dim fDate As Long, iDate As Long
Arr(i, 1) = iDate
là hêt lỗi ngay!

Cám ơn các anh nhiều. Thì ra là khai biến long, còn định dạng thì thì khai ở sh.
Vì đang làm bảng chấm công, muốn lấy Arr ngày nên dùng cách trên. Nó đang phù hợp với yêu cầu theo file đang làm.