Converter data da c...
 
Notifications
Clear all

Converter data da célula em número de série Excel VBA

7 Posts
2 Usuários
0 Likes
3,311 Visualizações
(@miltonmmjr)
Posts: 4
New Member
Topic starter
 

Bom dia tenho uma célula com a data no formato dd/mm/aaaa.
Acho que deveria ser algo parecido com função DATA.VALOR do Excel, só que não encontrei “WorksheetFunction.DATA.VALOR”.
A Verdade o que quero fazer é isso:
Criar abas automaticamente na planilha se não existir e colocar valores em uma determinada célula. No caso vou pegar a data inicial de uma célula e incrementando com o número de meses de outra célula, até agora não consegui nem colocar o mês concatenado com ano dessa forma “jan?2019”.
Juntando essas duas SUB.

Sub Inserir_plan_mês()

Dim i As String

i = Planilha5.Cells(1, 2).Value
ano = "_" & Year(i)
Sheets.Add after:=Worksheets(Worksheets.Count)
mes = UCase(Left(MonthName(i, True), 1)) + Mid((MonthName(i, True)), 2, Len(MonthName(i, True)))
mesano = mes + ano
ActiveSheet.Name = mesano

End Sub

Sub Parcelamento()
'
' Parcelamento Macro
''
      Dim linha, contador
  If Range("B6").Value = "" Then
  MsgBox "Informe PARCELA"
  Exit Sub
  End If
      If Range("B4").Value = "" Then
  MsgBox "Informe VALOR"
  Exit Sub
  End If
  
    If Range("B3").Value = "" Then
  MsgBox "Informe DATA"
  Exit Sub
  End If
  
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "=ROW()"
    linha = Range("F3").Value
    Range("F3:N100").Clear
    For contador = 1 To Range("B6").Value
        Range("F" & linha).Select
        ActiveCell.FormulaR1C1 = "=ROW()"
        Range("G" & linha).Select
        ActiveCell.FormulaR1C1 = "1"
        Range("H" & linha).Select
        ActiveCell.FormulaR1C1 = "=EDATE(R3C2,RC[-1])"
        Range("H" & linha).Value = Format(Range("H" & linha).Value, "mm/dd/yyyy")
        Range("I" & linha).Select
        ActiveCell.FormulaR1C1 = "=R4C2"
        Selection.Style = "Currency"
  
        linha = linha + 1
    Next contador

End Sub

miltonmmjr@hotmail.com

 
Postado : 23/11/2019 9:38 am
Reinaldo
(@rlm)
Posts: 246
Estimable Member
 

Não entendi a demanda, mas vamos por parte
Sua rotina, se entendi, pode ser escrita +/- assim:

Sub Parcelamento()
Dim linha, contador
'
' Parcelamento Macro
'
If Range("B6").Value = "" Then
    MsgBox "Informe PARCELA"
    Exit Sub
End If

If Range("B4").Value = "" Then
    MsgBox "Informe VALOR"
    Exit Sub
End If

If Range("B3").Value = "" Then
    MsgBox "Informe DATA"
    Exit Sub
End If

linha = Range("F3").Row
Range("F3:N100").Clear

For contador = 1 To Range("B6").Value
    Range("F" & linha).Value = linha
    Range("G" & linha).Value = contador
    Range("H" & linha).Value = VBA.DateAdd("m", contador, Range("B3").Value)
    Range("I" & linha).Value = Range("B4").Value
    Range("I" & linha).Style = "Currency"
    linha = linha + 1
Next contador
End Sub

Veja se está em linha com o que espera

Reinaldo

 
Postado : 23/11/2019 2:03 pm
(@miltonmmjr)
Posts: 4
New Member
Topic starter
 

Sim é isso que estou fazendo, mas além disso quero criar abas automaticamente na planilha com os meses das parcelas.
Ex: se colocar 3 parcelas iria criar as três linhas 10/12/2019, 10/01/2020, 10/02/2020 e três abas Dez_2019, Jan_2020, Fev_2020 e essa parte das três abas que não estou conseguindo fazer, pois teria que pegar a data que esta na célula "H" e converter em número para poder colocar na rotina.

 
Postado : 23/11/2019 8:25 pm
(@miltonmmjr)
Posts: 4
New Member
Topic starter
 

Estou quase chegando no que quero converti a data em um Número de série, só que estou com um erro na linha mes = UCase(Left(MonthName(i, True), 1)) + Mid((MonthName(i, True)), 2, Len(MonthName(i, True))) ERRO EM TEMPO DE EXECUÇÃO ‘5’: Argumento ou chamada de procedimento inválida.
Acho que corrigindo isso é só colocar esse código dentro da Sub Parcelamento().
Sub Inserir_plan_mês()

Dim a As String

a = Planilha5.Cells(3, 2).Value '(linha, col)
i = CLng(DateValue(a))
ano = "_" & Year(a)
Stop
Sheets.Add after:=Worksheets(Worksheets.Count)
mes = UCase(Left(MonthName(i, True), 1)) + Mid((MonthName(i, True)), 2, Len(MonthName(i, True)))
mesano = mes + ano
ActiveSheet.Name = mesano

End Sub

 
Postado : 24/11/2019 6:15 am
Reinaldo
(@rlm)
Posts: 246
Estimable Member
 

Experimente:

Sub Inserir_plan_mes()
Dim i As Integer
Dim MesAno As String
'Month retorna um numero de 1 a 12 que representa o mes da data requerida
i = Month(Planilha5.Cells(3, 2).Value)
'MonthName retorna o nome do mes, referente a um numero (de 1 a 12) passado
MesAno = UCase(MonthName(i, True)) & "_" & Year(Planilha5.Cells(3, 2).Value)
Stop
Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = MesAno
End Sub

Reinaldo

 
Postado : 24/11/2019 7:28 am
(@miltonmmjr)
Posts: 4
New Member
Topic starter
 

Obrigado, pela ajuda.
Agora gostaria de saber como verifico se a planilha já existe para não criar.

Sub Parcelamento()
Dim linha, contador
Dim i As Integer
Dim MesAno As String
'
' Parcelamento Macro
'
If Range("B6").Value = "" Then
    MsgBox "Informe PARCELA"
    Exit Sub
End If

If Range("B4").Value = "" Then
    MsgBox "Informe VALOR"
    Exit Sub
End If

If Range("B3").Value = "" Then
    MsgBox "Informe DATA"
    Exit Sub
End If

linha = Range("F3").Row
Range("F3:N100").Clear

For contador = 1 To Range("B6").Value
    Planilha11.Select
    Range("F" & linha).Value = linha
    Range("G" & linha).Value = contador
    Range("H" & linha).Value = VBA.DateAdd("m", contador, Range("B3").Value)
    Range("I" & linha).Value = Range("B4").Value
    Range("I" & linha).Style = "Currency"
    i = Month(Planilha11.Cells(linha, 8).Value)
    MesAno = UCase(MonthName(i, True)) & "_" & Year(Planilha11.Cells(3, 2).Value)
    Sheets.Add after:=Worksheets(Worksheets.Count)
Deveria ter um IF aqui, mas não sei como colocar
    ActiveSheet.Name = MesAno

    linha = linha + 1
Next contador
End Sub
 
Postado : 26/11/2019 12:06 pm
Reinaldo
(@rlm)
Posts: 246
Estimable Member
 

Uma possibilidade:

Sub Parcelamento()
Dim linha As Integer, contador As Integer, i As Integer 'Altere de integer para Long se atingir valores maoires que 32700
Dim Existe As Boolean
Dim MesAno As String
Dim sH As Worksheet
'
' Parcelamento Macro
'
If Range("B6").Value = "" Then
    MsgBox "Informe PARCELA"
    Exit Sub
End If

If Range("B4").Value = "" Then
    MsgBox "Informe VALOR"
    Exit Sub
End If

If Range("B3").Value = "" Then
    MsgBox "Informe DATA"
    Exit Sub
End If

linha = Range("F3").Row
Range("F3:N100").Clear

For contador = 1 To Range("B6").Value
    Planilha11.Select
    Range("F" & linha).Value = linha
    Range("G" & linha).Value = contador
    Range("H" & linha).Value = VBA.DateAdd("m", contador, Range("B3").Value)
    Range("I" & linha).Value = Range("B4").Value
    Range("I" & linha).Style = "Currency"
    i = Month(Planilha11.Cells(linha, 8).Value)
    MesAno = UCase(MonthName(i, True)) & "_" & Year(Planilha11.Cells(3, 2).Value)
        Existe = False
        For Each sH In Sheets 'verifica em todas as sheetes de existe com o nome definido em MesAno
            If sH.Name = MesAno Then Existe = True
        Next
        If Existe = False Then 'Se não existir cria a nova planilha
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = MesAno
        Else
            'Se existir defina aqui o que fazer, caso necessario
        End If
    linha = linha + 1
Next contador
End Sub

Reinaldo

 
Postado : 26/11/2019 12:40 pm