Набор даты в Excel

[jojo]

Нужно сделать макрос чтобы при вколачивании 8 знаков или 6 цифра преоразовалась к формату даты с разделителями . или - как в 1С бухгалтерии.

[GSerg]

Код: Выделить всё

private sub worksheet_change(byval tagret as excel.range)
  static dont as boolean
 
  if not dont then
    if isnumeric(target.value) then
      select case len(target.value)
      case 8
        dont=true
        target.value=dateserial(cint(right$(target.value,4)), cint(mid$(target.value,3,2)), cint(left$(target.value,2)))
        dont=false
      case 6
        dont=true
        target.value=dateserial(cint(right$(target.value,2)), cint(mid$(target.value,3,2)), cint(left$(target.value,2)))
        dont=false
      end select
    end if
  end if
end sub

[jojo]

работает
и если у меня не один столбец с датами а несколько
и еще столбцы не смежные
в других столбцах не нужно меять формат !
как тогда?

[jojo]

У меня счас вариант ...он меняет формат везде где попало ..
мне нужно только в конкретных столбцах !!!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim s As String
Dim Separator

Separator = "."
Target.Cells(1, 1).NumberFormat = "General"
'If Target.Left = NeedColumn Then
If Len(Target.Cells(1, 1)) = 8 Then
s = Target.Cells(1, 1)
Target.Cells(1, 1) = Mid(s, 1, 2) + Separator + Mid(s, 3, 2) + Separator + Mid(s, 5, 4)
Target.Cells(1, 1).NumberFormat = "m/d/yyyy"
End If
'End If
End Sub

[GSerg]

Код: Выделить всё

private sub worksheet_change(byval tagret as excel.range)
  static dont as boolean
 
  if not dont then
    select case target.column
    case 1,2,3
      if isnumeric(target.value) then
        select case len(target.value)
        case 8
          dont=true
          target.value=dateserial(cint(right$(target.value,4)), cint(mid$(target.value,3,2)), cint(left$(target.value,2)))
          dont=false
        case 6
          dont=true
          target.value=dateserial(cint(right$(target.value,2)), cint(mid$(target.value,3,2)), cint(left$(target.value,2)))
          dont=false
        end select
      end if
    end select
  end if
end sub

[jojo]

доделал напильником получилось круто спасибо большое